Changeset 2232 for palm/trunk/SOURCE/microphysics_mod.f90
- Timestamp:
- May 30, 2017 5:47:52 PM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/microphysics_mod.f90 (modified) (84 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/microphysics_mod.f90
r2156 r2232 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Adjustments to new topography and surface concept 23 23 ! 24 24 ! Former revisions: … … 402 402 403 403 USE indices, & 404 ONLY: nxlg, nxrg, ny sg, nyng, nzb_s_inner, nzt404 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 405 405 406 406 USE kinds … … 416 416 DO i = nxlg, nxrg 417 417 DO j = nysg, nyng 418 DO k = nzb _s_inner(j,i)+1, nzt418 DO k = nzb+1, nzt 419 419 IF ( qr(k,j,i) <= eps_sb ) THEN 420 420 qr(k,j,i) = 0.0_wp … … 422 422 ELSE 423 423 IF ( nr(k,j,i) * xrmin > qr(k,j,i) * hyrho(k) ) THEN 424 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin 424 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin * & 425 MERGE( 1.0_wp, 0.0_wp, & 426 BTEST( wall_flags_0(k,j,i), 0 ) ) 425 427 ELSEIF ( nr(k,j,i) * xrmax < qr(k,j,i) * hyrho(k) ) THEN 426 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax 428 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax * & 429 MERGE( 1.0_wp, 0.0_wp, & 430 BTEST( wall_flags_0(k,j,i), 0 ) ) 427 431 ENDIF 428 432 ENDIF … … 459 463 460 464 USE indices, & 461 ONLY: nxlg, nxrg, ny sg, nyng, nzb_s_inner, nzt465 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 462 466 463 467 USE kinds … … 472 476 REAL(wp) :: autocon !< 473 477 REAL(wp) :: dissipation !< 478 REAL(wp) :: flag !< flag to mask topography grid points 474 479 REAL(wp) :: k_au !< 475 480 REAL(wp) :: l_mix !< … … 487 492 DO i = nxlg, nxrg 488 493 DO j = nysg, nyng 489 DO k = nzb_s_inner(j,i)+1, nzt 494 DO k = nzb+1, nzt 495 ! 496 !-- Predetermine flag to mask topography 497 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 490 498 491 499 IF ( qc(k,j,i) > eps_sb ) THEN … … 554 562 autocon = MIN( autocon, qc(k,j,i) / dt_micro ) 555 563 556 qr(k,j,i) = qr(k,j,i) + autocon * dt_micro 557 qc(k,j,i) = qc(k,j,i) - autocon * dt_micro 558 nr(k,j,i) = nr(k,j,i) + autocon / x0 * hyrho(k) * dt_micro 564 qr(k,j,i) = qr(k,j,i) + autocon * dt_micro * flag 565 qc(k,j,i) = qc(k,j,i) - autocon * dt_micro * flag 566 nr(k,j,i) = nr(k,j,i) + autocon / x0 * hyrho(k) * dt_micro & 567 * flag 559 568 560 569 ENDIF … … 583 592 584 593 USE indices, & 585 ONLY: nxlg, nxrg, nyng, nysg, nzb _s_inner, nzt594 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 586 595 587 596 USE kinds … … 590 599 IMPLICIT NONE 591 600 592 INTEGER(iwp) :: i !< 593 INTEGER(iwp) :: j !< 594 INTEGER(iwp) :: k !< 601 INTEGER(iwp) :: i !< 602 INTEGER(iwp) :: j !< 603 INTEGER(iwp) :: k !< 604 INTEGER(iwp) :: k_wall !< topgraphy top index 595 605 596 606 REAL(wp) :: dqdt_precip !< 607 REAL(wp) :: flag !< flag to mask topography grid points 597 608 598 609 DO i = nxlg, nxrg 599 610 DO j = nysg, nyng 600 DO k = nzb_s_inner(j,i)+1, nzt 611 ! 612 !-- Determine vertical index of topography top 613 k_wall = MAXLOC( & 614 MERGE( 1, 0, & 615 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 616 ), DIM = 1 & 617 ) - 1 618 DO k = nzb+1, nzt 619 ! 620 !-- Predetermine flag to mask topography 621 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 601 622 602 623 IF ( qc(k,j,i) > ql_crit ) THEN … … 606 627 ENDIF 607 628 608 qc(k,j,i) = qc(k,j,i) - dqdt_precip * dt_micro 609 q(k,j,i) = q(k,j,i) - dqdt_precip * dt_micro 629 qc(k,j,i) = qc(k,j,i) - dqdt_precip * dt_micro * flag 630 q(k,j,i) = q(k,j,i) - dqdt_precip * dt_micro * flag 610 631 pt(k,j,i) = pt(k,j,i) + dqdt_precip * dt_micro * l_d_cp * & 611 pt_d_t(k) 632 pt_d_t(k) * flag 612 633 613 634 ! 614 635 !-- Compute the rain rate (stored on surface grid point) 615 prr(nzb_s_inner(j,i),j,i) = prr(nzb_s_inner(j,i),j,i) + & 616 dqdt_precip * dzw(k) 636 prr(k_wall,j,i) = prr(k_wall,j,i) + dqdt_precip * dzw(k) * flag 617 637 618 638 ENDDO … … 643 663 644 664 USE indices, & 645 ONLY: nxlg, nxrg, ny sg, nyng, nzb_s_inner, nzt665 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 646 666 647 667 USE kinds … … 654 674 655 675 REAL(wp) :: accr !< 676 REAL(wp) :: flag !< flag to mask topography grid points 656 677 REAL(wp) :: k_cr !< 657 678 REAL(wp) :: phi_ac !< … … 662 683 DO i = nxlg, nxrg 663 684 DO j = nysg, nyng 664 DO k = nzb_s_inner(j,i)+1, nzt 685 DO k = nzb+1, nzt 686 ! 687 !-- Predetermine flag to mask topography 688 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 665 689 666 690 IF ( ( qc(k,j,i) > eps_sb ) .AND. ( qr(k,j,i) > eps_sb ) ) THEN … … 690 714 accr = MIN( accr, qc(k,j,i) / dt_micro ) 691 715 692 qr(k,j,i) = qr(k,j,i) + accr * dt_micro 693 qc(k,j,i) = qc(k,j,i) - accr * dt_micro 716 qr(k,j,i) = qr(k,j,i) + accr * dt_micro * flag 717 qc(k,j,i) = qc(k,j,i) - accr * dt_micro * flag 694 718 695 719 ENDIF … … 724 748 725 749 USE indices, & 726 ONLY: nxlg, nxrg, ny sg, nyng, nzb_s_inner, nzt750 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 727 751 728 752 USE kinds … … 736 760 REAL(wp) :: breakup !< 737 761 REAL(wp) :: dr !< 762 REAL(wp) :: flag !< flag to mask topography grid points 738 763 REAL(wp) :: phi_br !< 739 764 REAL(wp) :: selfcoll !< … … 743 768 DO i = nxlg, nxrg 744 769 DO j = nysg, nyng 745 DO k = nzb_s_inner(j,i)+1, nzt 770 DO k = nzb+1, nzt 771 ! 772 !-- Predetermine flag to mask topography 773 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 774 746 775 IF ( qr(k,j,i) > eps_sb ) THEN 747 776 ! … … 763 792 764 793 selfcoll = MAX( breakup - selfcoll, -nr(k,j,i) / dt_micro ) 765 nr(k,j,i) = nr(k,j,i) + selfcoll * dt_micro 794 nr(k,j,i) = nr(k,j,i) + selfcoll * dt_micro * flag 766 795 767 796 ENDIF … … 796 825 797 826 USE indices, & 798 ONLY: nxlg, nxrg, ny sg, nyng, nzb_s_inner, nzt827 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 799 828 800 829 USE kinds … … 812 841 REAL(wp) :: evap_nr !< 813 842 REAL(wp) :: f_vent !< 843 REAL(wp) :: flag !< flag to mask topography grid points 814 844 REAL(wp) :: g_evap !< 815 845 REAL(wp) :: lambda_r !< … … 828 858 DO i = nxlg, nxrg 829 859 DO j = nysg, nyng 830 DO k = nzb_s_inner(j,i)+1, nzt 860 DO k = nzb+1, nzt 861 ! 862 !-- Predetermine flag to mask topography 863 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 864 831 865 IF ( qr(k,j,i) > eps_sb ) THEN 832 866 ! … … 916 950 -nr(k,j,i) / dt_micro ) 917 951 918 qr(k,j,i) = qr(k,j,i) + evap * dt_micro 919 nr(k,j,i) = nr(k,j,i) + evap_nr * dt_micro 952 qr(k,j,i) = qr(k,j,i) + evap * dt_micro * flag 953 nr(k,j,i) = nr(k,j,i) + evap_nr * dt_micro * flag 920 954 921 955 ENDIF … … 951 985 952 986 USE indices, & 953 ONLY: nxlg, nxrg, ny sg, nyng, nzb, nzb_s_inner, nzt987 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 954 988 955 989 USE kinds … … 965 999 INTEGER(iwp) :: k !< 966 1000 967 REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qc !< 1001 REAL(wp) :: flag !< flag to mask topography grid points 1002 REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qc !< 968 1003 969 1004 CALL cpu_log( log_point_s(59), 'sed_cloud', 'start' ) … … 973 1008 DO i = nxlg, nxrg 974 1009 DO j = nysg, nyng 975 DO k = nzt, nzb_s_inner(j,i)+1, -1 1010 DO k = nzt, nzb+1, -1 1011 ! 1012 !-- Predetermine flag to mask topography 1013 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 976 1014 977 1015 IF ( qc(k,j,i) > eps_sb ) THEN 978 1016 sed_qc(k) = sed_qc_const * nc_const**( -2.0_wp / 3.0_wp ) * & 979 ( qc(k,j,i) * hyrho(k) )**( 5.0_wp / 3.0_wp ) 1017 ( qc(k,j,i) * hyrho(k) )**( 5.0_wp / 3.0_wp ) * & 1018 flag 980 1019 ELSE 981 1020 sed_qc(k) = 0.0_wp … … 984 1023 sed_qc(k) = MIN( sed_qc(k), hyrho(k) * dzu(k+1) * q(k,j,i) / & 985 1024 dt_micro + sed_qc(k+1) & 986 ) 1025 ) * flag 987 1026 988 1027 q(k,j,i) = q(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) * & 989 ddzu(k+1) / hyrho(k) * dt_micro 1028 ddzu(k+1) / hyrho(k) * dt_micro * flag 990 1029 qc(k,j,i) = qc(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) * & 991 ddzu(k+1) / hyrho(k) * dt_micro 1030 ddzu(k+1) / hyrho(k) * dt_micro * flag 992 1031 pt(k,j,i) = pt(k,j,i) - ( sed_qc(k+1) - sed_qc(k) ) * & 993 1032 ddzu(k+1) / hyrho(k) * l_d_cp * & 994 pt_d_t(k) * dt_micro 1033 pt_d_t(k) * dt_micro * flag 995 1034 996 1035 ! … … 998 1037 IF ( call_microphysics_at_all_substeps ) THEN 999 1038 prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) & 1000 * weight_substep(intermediate_timestep_count) 1039 * weight_substep(intermediate_timestep_count) & 1040 * flag 1001 1041 ELSE 1002 prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) 1042 prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) * flag 1003 1043 ENDIF 1004 1044 … … 1032 1072 1033 1073 USE indices, & 1034 ONLY: nxlg, nxrg, ny sg, nyng, nzb, nzb_s_inner, nzt1074 ONLY: nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0 1035 1075 1036 1076 USE kinds … … 1039 1079 ONLY: weight_substep 1040 1080 1081 USE surface_mod, & 1082 ONLY : bc_h 1083 1041 1084 IMPLICIT NONE 1042 1085 1043 INTEGER(iwp) :: i !< 1044 INTEGER(iwp) :: j !< 1045 INTEGER(iwp) :: k !< 1046 INTEGER(iwp) :: k_run !< 1086 INTEGER(iwp) :: i !< running index x direction 1087 INTEGER(iwp) :: j !< running index y direction 1088 INTEGER(iwp) :: k !< running index z direction 1089 INTEGER(iwp) :: k_run !< 1090 INTEGER(iwp) :: l !< running index of surface type 1091 INTEGER(iwp) :: m !< running index surface elements 1092 INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint 1093 INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint 1047 1094 1048 1095 REAL(wp) :: c_run !< … … 1052 1099 REAL(wp) :: dr !< 1053 1100 REAL(wp) :: flux !< 1101 REAL(wp) :: flag !< flag to mask topography grid points 1054 1102 REAL(wp) :: lambda_r !< 1055 1103 REAL(wp) :: mu_r !< … … 1071 1119 DO i = nxlg, nxrg 1072 1120 DO j = nysg, nyng 1073 DO k = nzb_s_inner(j,i)+1, nzt 1121 DO k = nzb+1, nzt 1122 ! 1123 !-- Predetermine flag to mask topography 1124 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1125 1074 1126 IF ( qr(k,j,i) > eps_sb ) THEN 1075 1127 ! … … 1093 1145 ( mu_r + 1.0_wp ) ) & 1094 1146 ) & 1095 ) 1147 ) * flag 1096 1148 1097 1149 w_qr(k) = MAX( 0.1_wp, MIN( 20.0_wp, & … … 1101 1153 ( mu_r + 4.0_wp ) ) & 1102 1154 ) & 1103 ) 1155 ) * flag 1104 1156 ELSE 1105 1157 w_nr(k) = 0.0_wp … … 1108 1160 ENDDO 1109 1161 ! 1110 !-- Adjust boundary values 1111 w_nr(nzb_s_inner(j,i)) = w_nr(nzb_s_inner(j,i)+1) 1112 w_qr(nzb_s_inner(j,i)) = w_qr(nzb_s_inner(j,i)+1) 1162 !-- Adjust boundary values using surface data type. 1163 !-- Upward-facing 1164 surf_s = bc_h(0)%start_index(j,i) 1165 surf_e = bc_h(0)%end_index(j,i) 1166 DO m = surf_s, surf_e 1167 k = bc_h(0)%k(m) 1168 w_nr(k-1) = w_nr(k) 1169 w_qr(k-1) = w_qr(k) 1170 ENDDO 1171 ! 1172 !-- Downward-facing 1173 surf_s = bc_h(1)%start_index(j,i) 1174 surf_e = bc_h(1)%end_index(j,i) 1175 DO m = surf_s, surf_e 1176 k = bc_h(1)%k(m) 1177 w_nr(k+1) = w_nr(k) 1178 w_qr(k+1) = w_qr(k) 1179 ENDDO 1180 ! 1181 !-- Model top boundary value 1113 1182 w_nr(nzt+1) = 0.0_wp 1114 1183 w_qr(nzt+1) = 0.0_wp 1115 1184 ! 1116 1185 !-- Compute Courant number 1117 DO k = nzb_s_inner(j,i)+1, nzt 1186 DO k = nzb+1, nzt 1187 ! 1188 !-- Predetermine flag to mask topography 1189 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1190 1118 1191 c_nr(k) = 0.25_wp * ( w_nr(k-1) + & 1119 1192 2.0_wp * w_nr(k) + w_nr(k+1) ) * & 1120 dt_micro * ddzu(k) 1193 dt_micro * ddzu(k) * flag 1121 1194 c_qr(k) = 0.25_wp * ( w_qr(k-1) + & 1122 1195 2.0_wp * w_qr(k) + w_qr(k+1) ) * & 1123 dt_micro * ddzu(k) 1196 dt_micro * ddzu(k) * flag 1124 1197 ENDDO 1125 1198 ! … … 1127 1200 IF ( limiter_sedimentation ) THEN 1128 1201 1129 DO k = nzb_s_inner(j,i)+1, nzt 1202 DO k = nzb+1, nzt 1203 ! 1204 !-- Predetermine flag to mask topography 1205 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1206 1130 1207 d_mean = 0.5_wp * ( qr(k+1,j,i) - qr(k-1,j,i) ) 1131 1208 d_min = qr(k,j,i) - MIN( qr(k+1,j,i), qr(k,j,i), qr(k-1,j,i) ) … … 1134 1211 qr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min, & 1135 1212 2.0_wp * d_max, & 1136 ABS( d_mean ) ) 1213 ABS( d_mean ) ) & 1214 * flag 1137 1215 1138 1216 d_mean = 0.5_wp * ( nr(k+1,j,i) - nr(k-1,j,i) ) … … 1156 1234 ! 1157 1235 !-- Compute sedimentation flux 1158 DO k = nzt, nzb_s_inner(j,i)+1, -1 1159 ! 1160 !-- Sum up all rain drop number densities which contribute to the flux 1236 DO k = nzt, nzb+1, -1 1237 ! 1238 !-- Predetermine flag to mask topography 1239 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1240 ! 1241 !-- Sum up all rain drop number densities which contribute to the flux 1161 1242 !-- through k-1/2 1162 1243 flux = 0.0_wp … … 1167 1248 flux = flux + hyrho(k_run) * & 1168 1249 ( nr(k_run,j,i) + nr_slope(k_run) * & 1169 ( 1.0_wp - c_run ) * 0.5_wp ) * c_run * dzu(k_run) 1170 z_run = z_run + dzu(k_run) 1171 k_run = k_run + 1 1172 c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) ) 1250 ( 1.0_wp - c_run ) * 0.5_wp ) * c_run * dzu(k_run) & 1251 * flag 1252 z_run = z_run + dzu(k_run) * flag 1253 k_run = k_run + 1 * flag 1254 c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) ) & 1255 * flag 1173 1256 ENDDO 1174 1257 ! … … 1180 1263 ) 1181 1264 1182 sed_nr(k) = flux / dt_micro 1265 sed_nr(k) = flux / dt_micro * flag 1183 1266 nr(k,j,i) = nr(k,j,i) + ( sed_nr(k+1) - sed_nr(k) ) * & 1184 ddzu(k+1) / hyrho(k) * dt_micro 1267 ddzu(k+1) / hyrho(k) * dt_micro * flag 1185 1268 ! 1186 1269 !-- Sum up all rain water content which contributes to the flux … … 1195 1278 flux = flux + hyrho(k_run) * ( qr(k_run,j,i) + & 1196 1279 qr_slope(k_run) * ( 1.0_wp - c_run ) * & 1197 0.5_wp ) * c_run * dzu(k_run) 1198 z_run = z_run + dzu(k_run) 1199 k_run = k_run + 1 1200 c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) ) 1280 0.5_wp ) * c_run * dzu(k_run) * flag 1281 z_run = z_run + dzu(k_run) * flag 1282 k_run = k_run + 1 * flag 1283 c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) ) & 1284 * flag 1201 1285 1202 1286 ENDDO … … 1209 1293 ) 1210 1294 1211 sed_qr(k) = flux / dt_micro 1295 sed_qr(k) = flux / dt_micro * flag 1212 1296 1213 1297 qr(k,j,i) = qr(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) * & 1214 ddzu(k+1) / hyrho(k) * dt_micro 1298 ddzu(k+1) / hyrho(k) * dt_micro * flag 1215 1299 q(k,j,i) = q(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) * & 1216 ddzu(k+1) / hyrho(k) * dt_micro 1300 ddzu(k+1) / hyrho(k) * dt_micro * flag 1217 1301 pt(k,j,i) = pt(k,j,i) - ( sed_qr(k+1) - sed_qr(k) ) * & 1218 1302 ddzu(k+1) / hyrho(k) * l_d_cp * & 1219 pt_d_t(k) * dt_micro 1303 pt_d_t(k) * dt_micro * flag 1220 1304 ! 1221 1305 !-- Compute the rain rate 1222 1306 IF ( call_microphysics_at_all_substeps ) THEN 1223 1307 prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) & 1224 * weight_substep(intermediate_timestep_count) 1308 * weight_substep(intermediate_timestep_count) & 1309 * flag 1225 1310 ELSE 1226 prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) 1311 prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) * flag 1227 1312 ENDIF 1228 1313 … … 1256 1341 1257 1342 USE indices, & 1258 ONLY: nxl, nxr, nys, nyn, nzb _s_inner1343 ONLY: nxl, nxr, nys, nyn, nzb, nzt, wall_flags_0 1259 1344 1260 1345 USE kinds 1261 1346 1347 USE surface_mod, & 1348 ONLY : bc_h 1349 1262 1350 IMPLICIT NONE 1263 1351 1264 INTEGER(iwp) :: i !: 1265 INTEGER(iwp) :: j !: 1266 1352 INTEGER(iwp) :: i !< running index x direction 1353 INTEGER(iwp) :: j !< running index y direction 1354 INTEGER(iwp) :: k !< running index y direction 1355 INTEGER(iwp) :: m !< running index surface elements 1356 INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint 1357 INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint 1267 1358 1268 1359 IF ( ( dt_do2d_xy - time_do2d_xy ) < precipitation_amount_interval .AND.& … … 1270 1361 intermediate_timestep_count == intermediate_timestep_count_max ) ) & 1271 1362 THEN 1272 1273 DO i = nxl, nxr 1274 DO j = nys, nyn1275 1276 precipitation_amount(j,i) = precipitation_amount(j,i) + &1277 prr(nzb_s_inner(j,i)+1,j,i) * &1278 hyrho(nzb_s_inner(j,i)+1) * dt_3d1279 1280 ENDDO1363 ! 1364 !-- Run over all upward-facing surface elements, i.e. non-natural, 1365 !-- natural and urban 1366 DO m = 1, bc_h(0)%ns 1367 i = bc_h(0)%i(m) 1368 j = bc_h(0)%j(m) 1369 k = bc_h(0)%k(m) 1370 precipitation_amount(j,i) = precipitation_amount(j,i) + & 1371 prr(k,j,i) * hyrho(k) * dt_3d 1281 1372 ENDDO 1373 1282 1374 ENDIF 1283 1375 … … 1410 1502 1411 1503 USE indices, & 1412 ONLY: nzb _s_inner, nzt1504 ONLY: nzb, nzt, wall_flags_0 1413 1505 1414 1506 USE kinds … … 1420 1512 INTEGER(iwp) :: k !< 1421 1513 1422 DO k = nzb_s_inner(j,i)+1, nzt 1514 REAL(wp) :: flag !< flag to indicate first grid level above surface 1515 1516 DO k = nzb+1, nzt 1517 ! 1518 !-- Predetermine flag to mask topography 1519 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1423 1520 1424 1521 IF ( qr_1d(k) <= eps_sb ) THEN … … 1431 1528 !-- too big weights of rain drops (Stevens and Seifert, 2008). 1432 1529 IF ( nr_1d(k) * xrmin > qr_1d(k) * hyrho(k) ) THEN 1433 nr_1d(k) = qr_1d(k) * hyrho(k) / xrmin 1530 nr_1d(k) = qr_1d(k) * hyrho(k) / xrmin * flag 1434 1531 ELSEIF ( nr_1d(k) * xrmax < qr_1d(k) * hyrho(k) ) THEN 1435 nr_1d(k) = qr_1d(k) * hyrho(k) / xrmax 1532 nr_1d(k) = qr_1d(k) * hyrho(k) / xrmax * flag 1436 1533 ENDIF 1437 1534 … … 1463 1560 1464 1561 USE indices, & 1465 ONLY: nzb _s_inner, nzt1562 ONLY: nzb, nzt, wall_flags_0 1466 1563 1467 1564 USE kinds … … 1476 1573 REAL(wp) :: autocon !< 1477 1574 REAL(wp) :: dissipation !< 1575 REAL(wp) :: flag !< flag to indicate first grid level above surface 1478 1576 REAL(wp) :: k_au !< 1479 1577 REAL(wp) :: l_mix !< … … 1487 1585 REAL(wp) :: xc !< 1488 1586 1489 DO k = nzb_s_inner(j,i)+1, nzt 1587 DO k = nzb+1, nzt 1588 ! 1589 !-- Predetermine flag to mask topography 1590 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1490 1591 1491 1592 IF ( qc_1d(k) > eps_sb ) THEN … … 1551 1652 autocon = MIN( autocon, qc_1d(k) / dt_micro ) 1552 1653 1553 qr_1d(k) = qr_1d(k) + autocon * dt_micro 1554 qc_1d(k) = qc_1d(k) - autocon * dt_micro 1555 nr_1d(k) = nr_1d(k) + autocon / x0 * hyrho(k) * dt_micro 1654 qr_1d(k) = qr_1d(k) + autocon * dt_micro * flag 1655 qc_1d(k) = qc_1d(k) - autocon * dt_micro * flag 1656 nr_1d(k) = nr_1d(k) + autocon / x0 * hyrho(k) * dt_micro * flag 1556 1657 1557 1658 ENDIF … … 1575 1676 1576 1677 USE indices, & 1577 ONLY: nzb _s_inner, nzt1678 ONLY: nzb, nzb_max, nzt, wall_flags_0 1578 1679 1579 1680 USE kinds … … 1582 1683 IMPLICIT NONE 1583 1684 1584 INTEGER(iwp) :: i !< 1585 INTEGER(iwp) :: j !< 1586 INTEGER(iwp) :: k !< 1685 INTEGER(iwp) :: i !< 1686 INTEGER(iwp) :: j !< 1687 INTEGER(iwp) :: k !< 1688 INTEGER(iwp) :: k_wall !< topography top index 1587 1689 1588 1690 REAL(wp) :: dqdt_precip !< 1589 1590 DO k = nzb_s_inner(j,i)+1, nzt 1691 REAL(wp) :: flag !< flag to indicate first grid level above surface 1692 1693 ! 1694 !-- Determine vertical index of topography top 1695 k_wall = MAXLOC( & 1696 MERGE( 1, 0, & 1697 BTEST( wall_flags_0(nzb:nzb_max,j,i), 12 ) & 1698 ), DIM = 1 & 1699 ) - 1 1700 DO k = nzb+1, nzt 1701 ! 1702 !-- Predetermine flag to mask topography 1703 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1591 1704 1592 1705 IF ( qc_1d(k) > ql_crit ) THEN … … 1596 1709 ENDIF 1597 1710 1598 qc_1d(k) = qc_1d(k) - dqdt_precip * dt_micro 1599 q_1d(k) = q_1d(k) - dqdt_precip * dt_micro 1600 pt_1d(k) = pt_1d(k) + dqdt_precip * dt_micro * l_d_cp * pt_d_t(k) 1711 qc_1d(k) = qc_1d(k) - dqdt_precip * dt_micro * flag 1712 q_1d(k) = q_1d(k) - dqdt_precip * dt_micro * flag 1713 pt_1d(k) = pt_1d(k) + dqdt_precip * dt_micro * l_d_cp * pt_d_t(k) * flag 1601 1714 1602 1715 ! 1603 1716 !-- Compute the rain rate (stored on surface grid point) 1604 prr(nzb_s_inner(j,i),j,i) = prr(nzb_s_inner(j,i),j,i) + & 1605 dqdt_precip * dzw(k) 1717 prr(k_wall,j,i) = prr(k_wall,j,i) + dqdt_precip * dzw(k) * flag 1606 1718 1607 1719 ENDDO … … 1626 1738 1627 1739 USE indices, & 1628 ONLY: nzb _s_inner, nzt1740 ONLY: nzb, nzt, wall_flags_0 1629 1741 1630 1742 USE kinds … … 1637 1749 1638 1750 REAL(wp) :: accr !< 1751 REAL(wp) :: flag !< flag to indicate first grid level above surface 1639 1752 REAL(wp) :: k_cr !< 1640 1753 REAL(wp) :: phi_ac !< 1641 1754 REAL(wp) :: tau_cloud !< 1642 1755 1643 DO k = nzb_s_inner(j,i)+1, nzt 1756 DO k = nzb+1, nzt 1757 ! 1758 !-- Predetermine flag to mask topography 1759 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1760 1644 1761 IF ( ( qc_1d(k) > eps_sb ) .AND. ( qr_1d(k) > eps_sb ) ) THEN 1645 1762 ! … … 1667 1784 accr = MIN( accr, qc_1d(k) / dt_micro ) 1668 1785 1669 qr_1d(k) = qr_1d(k) + accr * dt_micro 1670 qc_1d(k) = qc_1d(k) - accr * dt_micro 1786 qr_1d(k) = qr_1d(k) + accr * dt_micro * flag 1787 qc_1d(k) = qc_1d(k) - accr * dt_micro * flag 1671 1788 1672 1789 ENDIF … … 1691 1808 1692 1809 USE indices, & 1693 ONLY: nzb _s_inner, nzt1810 ONLY: nzb, nzt, wall_flags_0 1694 1811 1695 1812 USE kinds … … 1703 1820 REAL(wp) :: breakup !< 1704 1821 REAL(wp) :: dr !< 1822 REAL(wp) :: flag !< flag to indicate first grid level above surface 1705 1823 REAL(wp) :: phi_br !< 1706 1824 REAL(wp) :: selfcoll !< 1707 1825 1708 DO k = nzb_s_inner(j,i)+1, nzt 1826 DO k = nzb+1, nzt 1827 ! 1828 !-- Predetermine flag to mask topography 1829 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1830 1709 1831 IF ( qr_1d(k) > eps_sb ) THEN 1710 1832 ! … … 1724 1846 1725 1847 selfcoll = MAX( breakup - selfcoll, -nr_1d(k) / dt_micro ) 1726 nr_1d(k) = nr_1d(k) + selfcoll * dt_micro 1848 nr_1d(k) = nr_1d(k) + selfcoll * dt_micro * flag 1727 1849 1728 1850 ENDIF … … 1750 1872 1751 1873 USE indices, & 1752 ONLY: nzb _s_inner, nzt1874 ONLY: nzb, nzt, wall_flags_0 1753 1875 1754 1876 USE kinds … … 1766 1888 REAL(wp) :: evap_nr !< 1767 1889 REAL(wp) :: f_vent !< 1890 REAL(wp) :: flag !< flag to indicate first grid level above surface 1768 1891 REAL(wp) :: g_evap !< 1769 1892 REAL(wp) :: lambda_r !< … … 1778 1901 REAL(wp) :: xr !< 1779 1902 1780 DO k = nzb_s_inner(j,i)+1, nzt 1903 DO k = nzb+1, nzt 1904 ! 1905 !-- Predetermine flag to mask topography 1906 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 1907 1781 1908 IF ( qr_1d(k) > eps_sb ) THEN 1782 1909 ! … … 1862 1989 -nr_1d(k) / dt_micro ) 1863 1990 1864 qr_1d(k) = qr_1d(k) + evap * dt_micro 1865 nr_1d(k) = nr_1d(k) + evap_nr * dt_micro 1991 qr_1d(k) = qr_1d(k) + evap * dt_micro * flag 1992 nr_1d(k) = nr_1d(k) + evap_nr * dt_micro * flag 1866 1993 1867 1994 ENDIF … … 1891 2018 1892 2019 USE indices, & 1893 ONLY: nzb, nzb _s_inner, nzt2020 ONLY: nzb, nzb, nzt, wall_flags_0 1894 2021 1895 2022 USE kinds … … 1904 2031 INTEGER(iwp) :: k !< 1905 2032 1906 REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qc !< 2033 REAL(wp) :: flag !< flag to indicate first grid level above surface 2034 REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qc !< 1907 2035 1908 2036 sed_qc(nzt+1) = 0.0_wp 1909 2037 1910 DO k = nzt, nzb_s_inner(j,i)+1, -1 2038 DO k = nzt, nzb+1, -1 2039 ! 2040 !-- Predetermine flag to mask topography 2041 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 2042 1911 2043 IF ( qc_1d(k) > eps_sb ) THEN 1912 2044 sed_qc(k) = sed_qc_const * nc_1d(k)**( -2.0_wp / 3.0_wp ) * & 1913 ( qc_1d(k) * hyrho(k) )**( 5.0_wp / 3.0_wp ) 2045 ( qc_1d(k) * hyrho(k) )**( 5.0_wp / 3.0_wp ) * flag 1914 2046 ELSE 1915 2047 sed_qc(k) = 0.0_wp … … 1918 2050 sed_qc(k) = MIN( sed_qc(k), hyrho(k) * dzu(k+1) * q_1d(k) / & 1919 2051 dt_micro + sed_qc(k+1) & 1920 ) 2052 ) * flag 1921 2053 1922 2054 q_1d(k) = q_1d(k) + ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / & 1923 hyrho(k) * dt_micro 2055 hyrho(k) * dt_micro * flag 1924 2056 qc_1d(k) = qc_1d(k) + ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / & 1925 hyrho(k) * dt_micro 2057 hyrho(k) * dt_micro * flag 1926 2058 pt_1d(k) = pt_1d(k) - ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / & 1927 hyrho(k) * l_d_cp * pt_d_t(k) * dt_micro 2059 hyrho(k) * l_d_cp * pt_d_t(k) * dt_micro * flag 1928 2060 1929 2061 ! 1930 2062 !-- Compute the precipitation rate of cloud (fog) droplets 1931 2063 IF ( call_microphysics_at_all_substeps ) THEN 1932 prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) * &1933 weight_substep(intermediate_timestep_count)2064 prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) * & 2065 weight_substep(intermediate_timestep_count) * flag 1934 2066 ELSE 1935 prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) 2067 prr(k,j,i) = prr(k,j,i) + sed_qc(k) / hyrho(k) * flag 1936 2068 ENDIF 1937 2069 … … 1959 2091 1960 2092 USE indices, & 1961 ONLY: nzb, nzb _s_inner, nzt2093 ONLY: nzb, nzb, nzt, wall_flags_0 1962 2094 1963 2095 USE kinds … … 1966 2098 ONLY: weight_substep 1967 2099 2100 USE surface_mod, & 2101 ONLY : bc_h 2102 1968 2103 IMPLICIT NONE 1969 2104 1970 INTEGER(iwp) :: i !< 1971 INTEGER(iwp) :: j !< 1972 INTEGER(iwp) :: k !< 1973 INTEGER(iwp) :: k_run !< 2105 INTEGER(iwp) :: i !< running index x direction 2106 INTEGER(iwp) :: j !< running index y direction 2107 INTEGER(iwp) :: k !< running index z direction 2108 INTEGER(iwp) :: k_run !< 2109 INTEGER(iwp) :: m !< running index surface elements 2110 INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint 2111 INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint 1974 2112 1975 2113 REAL(wp) :: c_run !< … … 1979 2117 REAL(wp) :: dr !< 1980 2118 REAL(wp) :: flux !< 2119 REAL(wp) :: flag !< flag to indicate first grid level above surface 1981 2120 REAL(wp) :: lambda_r !< 1982 2121 REAL(wp) :: mu_r !< … … 1994 2133 ! 1995 2134 !-- Compute velocities 1996 DO k = nzb_s_inner(j,i)+1, nzt 2135 DO k = nzb+1, nzt 2136 ! 2137 !-- Predetermine flag to mask topography 2138 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 2139 1997 2140 IF ( qr_1d(k) > eps_sb ) THEN 1998 2141 ! … … 2013 2156 ( mu_r + 1.0_wp ) ) & 2014 2157 ) & 2015 ) 2158 ) * flag 2016 2159 w_qr(k) = MAX( 0.1_wp, MIN( 20.0_wp, & 2017 2160 a_term - b_term * ( 1.0_wp + & … … 2019 2162 ( mu_r + 4.0_wp ) ) & 2020 2163 ) & 2021 ) 2164 ) * flag 2022 2165 ELSE 2023 2166 w_nr(k) = 0.0_wp … … 2026 2169 ENDDO 2027 2170 ! 2028 !-- Adjust boundary values 2029 w_nr(nzb_s_inner(j,i)) = w_nr(nzb_s_inner(j,i)+1) 2030 w_qr(nzb_s_inner(j,i)) = w_qr(nzb_s_inner(j,i)+1) 2171 !-- Adjust boundary values using surface data type. 2172 !-- Upward facing non-natural 2173 surf_s = bc_h(0)%start_index(j,i) 2174 surf_e = bc_h(0)%end_index(j,i) 2175 DO m = surf_s, surf_e 2176 k = bc_h(0)%k(m) 2177 w_nr(k-1) = w_nr(k) 2178 w_qr(k-1) = w_qr(k) 2179 ENDDO 2180 ! 2181 !-- Downward facing non-natural 2182 surf_s = bc_h(1)%start_index(j,i) 2183 surf_e = bc_h(1)%end_index(j,i) 2184 DO m = surf_s, surf_e 2185 k = bc_h(1)%k(m) 2186 w_nr(k+1) = w_nr(k) 2187 w_qr(k+1) = w_qr(k) 2188 ENDDO 2189 ! 2190 !-- Neumann boundary condition at model top 2031 2191 w_nr(nzt+1) = 0.0_wp 2032 2192 w_qr(nzt+1) = 0.0_wp 2033 2193 ! 2034 2194 !-- Compute Courant number 2035 DO k = nzb_s_inner(j,i)+1, nzt 2195 DO k = nzb+1, nzt 2196 ! 2197 !-- Predetermine flag to mask topography 2198 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 2199 2036 2200 c_nr(k) = 0.25_wp * ( w_nr(k-1) + 2.0_wp * w_nr(k) + w_nr(k+1) ) * & 2037 dt_micro * ddzu(k) 2201 dt_micro * ddzu(k) * flag 2038 2202 c_qr(k) = 0.25_wp * ( w_qr(k-1) + 2.0_wp * w_qr(k) + w_qr(k+1) ) * & 2039 dt_micro * ddzu(k) 2203 dt_micro * ddzu(k) * flag 2040 2204 ENDDO 2041 2205 ! … … 2043 2207 IF ( limiter_sedimentation ) THEN 2044 2208 2045 DO k = nzb_s_inner(j,i)+1, nzt 2209 DO k = nzb+1, nzt 2210 ! 2211 !-- Predetermine flag to mask topography 2212 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 2213 2046 2214 d_mean = 0.5_wp * ( qr_1d(k+1) - qr_1d(k-1) ) 2047 2215 d_min = qr_1d(k) - MIN( qr_1d(k+1), qr_1d(k), qr_1d(k-1) ) … … 2050 2218 qr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min, & 2051 2219 2.0_wp * d_max, & 2052 ABS( d_mean ) ) 2220 ABS( d_mean ) ) * flag 2053 2221 2054 2222 d_mean = 0.5_wp * ( nr_1d(k+1) - nr_1d(k-1) ) … … 2058 2226 nr_slope(k) = SIGN(1.0_wp, d_mean) * MIN ( 2.0_wp * d_min, & 2059 2227 2.0_wp * d_max, & 2060 ABS( d_mean ) ) 2228 ABS( d_mean ) ) * flag 2061 2229 ENDDO 2062 2230 … … 2072 2240 ! 2073 2241 !-- Compute sedimentation flux 2074 DO k = nzt, nzb_s_inner(j,i)+1, -1 2075 ! 2076 !-- Sum up all rain drop number densities which contribute to the flux 2242 DO k = nzt, nzb+1, -1 2243 ! 2244 !-- Predetermine flag to mask topography 2245 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 2246 ! 2247 !-- Sum up all rain drop number densities which contribute to the flux 2077 2248 !-- through k-1/2 2078 2249 flux = 0.0_wp … … 2083 2254 flux = flux + hyrho(k_run) * & 2084 2255 ( nr_1d(k_run) + nr_slope(k_run) * ( 1.0_wp - c_run ) * & 2085 0.5_wp ) * c_run * dzu(k_run) 2086 z_run = z_run + dzu(k_run) 2087 k_run = k_run + 1 2088 c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) ) 2256 0.5_wp ) * c_run * dzu(k_run) * flag 2257 z_run = z_run + dzu(k_run) * flag 2258 k_run = k_run + 1 * flag 2259 c_run = MIN( 1.0_wp, c_nr(k_run) - z_run * ddzu(k_run) ) * flag 2089 2260 ENDDO 2090 2261 ! … … 2094 2265 hyrho(k) * dzu(k+1) * nr_1d(k) + sed_nr(k+1) * dt_micro ) 2095 2266 2096 sed_nr(k) = flux / dt_micro 2267 sed_nr(k) = flux / dt_micro * flag 2097 2268 nr_1d(k) = nr_1d(k) + ( sed_nr(k+1) - sed_nr(k) ) * ddzu(k+1) / & 2098 hyrho(k) * dt_micro 2269 hyrho(k) * dt_micro * flag 2099 2270 ! 2100 2271 !-- Sum up all rain water content which contributes to the flux … … 2109 2280 flux = flux + hyrho(k_run) * & 2110 2281 ( qr_1d(k_run) + qr_slope(k_run) * ( 1.0_wp - c_run ) * & 2111 0.5_wp ) * c_run * dzu(k_run) 2112 z_run = z_run + dzu(k_run) 2113 k_run = k_run + 1 2114 c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) ) 2282 0.5_wp ) * c_run * dzu(k_run) * flag 2283 z_run = z_run + dzu(k_run) * flag 2284 k_run = k_run + 1 * flag 2285 c_run = MIN( 1.0_wp, c_qr(k_run) - z_run * ddzu(k_run) ) * flag 2115 2286 2116 2287 ENDDO … … 2120 2291 hyrho(k) * dzu(k) * qr_1d(k) + sed_qr(k+1) * dt_micro ) 2121 2292 2122 sed_qr(k) = flux / dt_micro 2293 sed_qr(k) = flux / dt_micro * flag 2123 2294 2124 2295 qr_1d(k) = qr_1d(k) + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / & 2125 hyrho(k) * dt_micro 2296 hyrho(k) * dt_micro * flag 2126 2297 q_1d(k) = q_1d(k) + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / & 2127 hyrho(k) * dt_micro 2298 hyrho(k) * dt_micro * flag 2128 2299 pt_1d(k) = pt_1d(k) - ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / & 2129 hyrho(k) * l_d_cp * pt_d_t(k) * dt_micro 2300 hyrho(k) * l_d_cp * pt_d_t(k) * dt_micro * flag 2130 2301 ! 2131 2302 !-- Compute the rain rate 2132 2303 IF ( call_microphysics_at_all_substeps ) THEN 2133 2304 prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) & 2134 * weight_substep(intermediate_timestep_count) 2305 * weight_substep(intermediate_timestep_count) * flag 2135 2306 ELSE 2136 prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) 2307 prr(k,j,i) = prr(k,j,i) + sed_qr(k) / hyrho(k) * flag 2137 2308 ENDIF 2138 2309 … … 2162 2333 2163 2334 USE indices, & 2164 ONLY: nzb _s_inner2335 ONLY: nzb, nzt, wall_flags_0 2165 2336 2166 2337 USE kinds 2167 2338 2339 USE surface_mod, & 2340 ONLY : bc_h 2341 2168 2342 IMPLICIT NONE 2169 2343 2170 INTEGER(iwp) :: i !: 2171 INTEGER(iwp) :: j !: 2172 2344 INTEGER(iwp) :: i !< running index x direction 2345 INTEGER(iwp) :: j !< running index y direction 2346 INTEGER(iwp) :: k !< running index z direction 2347 INTEGER(iwp) :: m !< running index surface elements 2348 INTEGER(iwp) :: surf_e !< End index of surface elements at (j,i)-gridpoint 2349 INTEGER(iwp) :: surf_s !< Start index of surface elements at (j,i)-gridpoint 2173 2350 2174 2351 IF ( ( dt_do2d_xy - time_do2d_xy ) < precipitation_amount_interval .AND.& … … 2177 2354 THEN 2178 2355 2179 precipitation_amount(j,i) = precipitation_amount(j,i) + & 2180 prr(nzb_s_inner(j,i)+1,j,i) * & 2181 hyrho(nzb_s_inner(j,i)+1) * dt_3d 2356 surf_s = bc_h(0)%start_index(j,i) 2357 surf_e = bc_h(0)%end_index(j,i) 2358 DO m = surf_s, surf_e 2359 k = bc_h(0)%k(m) 2360 precipitation_amount(j,i) = precipitation_amount(j,i) + & 2361 prr(k,j,i) * hyrho(k) * dt_3d 2362 ENDDO 2363 2182 2364 ENDIF 2183 2365
Note: See TracChangeset
for help on using the changeset viewer.
