Changeset 4502 for palm/trunk
- Timestamp:
- Apr 17, 2020 4:14:16 PM (5 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 12 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/advec_s_bc.f90
r4488 r4502 24 24 ! ----------------- 25 25 ! $Id$ 26 ! Implementation of ice microphysics 27 ! 28 ! 4488 2020-04-03 11:34:29Z raasch 26 29 ! file re-formatted to follow the PALM coding standard 27 30 ! … … 957 960 ENDDO 958 961 959 ELSEIF ( sk_char == 'q r' ) THEN960 961 ! 962 !-- Rain water content boundary condition at the bottom boundary: Dirichlet (fixed surface963 !-- rain water content).962 ELSEIF ( sk_char == 'qi' ) THEN 963 964 ! 965 !-- Ice crystal content boundary condition at the bottom boundary: 966 !-- Dirichlet (fixed surface rain water content). 964 967 DO i = nxl, nxr 965 968 DO j = nys, nyn … … 971 974 972 975 ! 973 !-- Rain watercontent boundary condition at the top boundary: Dirichlet976 !-- Ice crystal content boundary condition at the top boundary: Dirichlet 974 977 DO i = nxl, nxr 975 978 DO j = nys, nyn … … 979 982 ENDDO 980 983 981 ELSEIF ( sk_char == ' nc' ) THEN982 983 ! 984 !-- Cloud drop concentration boundary condition at the bottom boundary: Dirichlet (fixed985 !-- surface cloud drop concentration).984 ELSEIF ( sk_char == 'qr' ) THEN 985 986 ! 987 !-- Rain water content boundary condition at the bottom boundary: Dirichlet (fixed surface 988 !-- rain water content). 986 989 DO i = nxl, nxr 987 990 DO j = nys, nyn … … 993 996 994 997 ! 998 !-- Rain water content boundary condition at the top boundary: Dirichlet 999 DO i = nxl, nxr 1000 DO j = nys, nyn 1001 sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i) 1002 sk_p(nzt+3,j,i) = sk_p(nzt+1,j,i) 1003 ENDDO 1004 ENDDO 1005 1006 ELSEIF ( sk_char == 'nc' ) THEN 1007 1008 ! 1009 !-- Cloud drop concentration boundary condition at the bottom boundary: Dirichlet (fixed 1010 !-- surface cloud drop concentration). 1011 DO i = nxl, nxr 1012 DO j = nys, nyn 1013 sk_p(nzb,j,i) = sk_p(nzb+1,j,i) 1014 sk_p(nzb-1,j,i) = sk_p(nzb,j,i) 1015 sk_p(nzb-2,j,i) = sk_p(nzb,j,i) 1016 ENDDO 1017 ENDDO 1018 1019 ! 995 1020 !-- Cloud drop concentration boundary condition at the top boundary: Dirichlet 1021 DO i = nxl, nxr 1022 DO j = nys, nyn 1023 sk_p(nzt+2,j,i) = sk_p(nzt+1,j,i) 1024 sk_p(nzt+3,j,i) = sk_p(nzt+1,j,i) 1025 ENDDO 1026 ENDDO 1027 1028 ELSEIF ( sk_char == 'ni' ) THEN 1029 1030 ! 1031 !-- Ice crystal concentration boundary condition at the bottom boundary: 1032 !-- Dirichlet (fixed surface cloud drop concentration). 1033 DO i = nxl, nxr 1034 DO j = nys, nyn 1035 sk_p(nzb,j,i) = sk_p(nzb+1,j,i) 1036 sk_p(nzb-1,j,i) = sk_p(nzb,j,i) 1037 sk_p(nzb-2,j,i) = sk_p(nzb,j,i) 1038 ENDDO 1039 ENDDO 1040 1041 ! 1042 !-- Ice crystal concentration boundary condition at the top boundary: Dirichlet 996 1043 DO i = nxl, nxr 997 1044 DO j = nys, nyn -
palm/trunk/SOURCE/advec_ws.f90
r4469 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4469 2020-03-23 14:31:00Z suehring 27 30 ! fix mistakenly committed version 28 31 ! … … 240 243 sums_wssas_ws_l, sums_wsus_ws_l, sums_wsvs_ws_l, & 241 244 sums_wsqcs_ws_l, sums_wsqrs_ws_l, & 245 sums_wsqis_ws_l, sums_wsnis_ws_l, & 242 246 sums_wsncs_ws_l, sums_wsnrs_ws_l, & 243 247 hom, weight_substep … … 1938 1942 ENDDO 1939 1943 1944 CASE ( 'qi' ) 1945 1946 DO k = nzb, nzt 1947 sums_wsqis_ws_l(k,tn) = sums_wsqis_ws_l(k,tn) + & 1948 ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 1949 * ( w(k,j,i) - hom(k,1,3,0) ) & 1950 + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 1951 * ABS( w(k,j,i) - hom(k,1,3,0) ) & 1952 ) * weight_substep(intermediate_timestep_count) 1953 ENDDO 1940 1954 1941 1955 CASE ( 'qr' ) … … 1954 1968 DO k = nzb, nzt 1955 1969 sums_wsncs_ws_l(k,tn) = sums_wsncs_ws_l(k,tn) + & 1970 ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 1971 * ( w(k,j,i) - hom(k,1,3,0) ) & 1972 + diss_t(k) / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 1973 * ABS( w(k,j,i) - hom(k,1,3,0) ) & 1974 ) * weight_substep(intermediate_timestep_count) 1975 ENDDO 1976 1977 CASE ( 'ni' ) 1978 1979 DO k = nzb, nzt 1980 sums_wsnis_ws_l(k,tn) = sums_wsnis_ws_l(k,tn) + & 1956 1981 ( flux_t(k) / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 1957 1982 * ( w(k,j,i) - hom(k,1,3,0) ) & … … 3798 3823 CASE ( 'aerosol_mass', 'aerosol_number', 'salsa_gas' ) 3799 3824 sk_num = 9 3825 CASE ( 'ni' ) 3826 sk_num = 10 3827 CASE ( 'qi' ) 3828 sk_num = 11 3800 3829 CASE DEFAULT 3801 3830 sk_num = 0 … … 3824 3853 !$ACC PRESENT(sums_wsqrs_ws_l, sums_wsncs_ws_l) & 3825 3854 !$ACC PRESENT(sums_wsnrs_ws_l, sums_wsss_ws_l) & 3855 !$ACC PRESENT(sums_wsnis_ws_l, sums_wsqis_ws_l) & 3826 3856 !$ACC PRESENT(sums_salsa_ws_l) 3827 3857 DO i = nxl, nxr … … 4517 4547 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 4518 4548 ) * weight_substep(intermediate_timestep_count) 4549 CASE ( 10 ) 4550 !$ACC ATOMIC 4551 sums_wsnis_ws_l(k,tn) = sums_wsnis_ws_l(k,tn) & 4552 + ( flux_t(k) & 4553 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 4554 * ( w(k,j,i) - hom(k,1,3,0) ) & 4555 + diss_t(k) & 4556 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 4557 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 4558 ) * weight_substep(intermediate_timestep_count) 4559 CASE ( 11 ) 4560 !$ACC ATOMIC 4561 sums_wsqis_ws_l(k,tn) = sums_wsqis_ws_l(k,tn) & 4562 + ( flux_t(k) & 4563 / ( w(k,j,i) + SIGN( 1.0E-20_wp, w(k,j,i) ) ) & 4564 * ( w(k,j,i) - hom(k,1,3,0) ) & 4565 + diss_t(k) & 4566 / ( ABS(w(k,j,i)) + 1.0E-20_wp ) & 4567 * ABS(w(k,j,i) - hom(k,1,3,0) ) & 4568 ) * weight_substep(intermediate_timestep_count) 4519 4569 4520 4570 END SELECT -
palm/trunk/SOURCE/basic_constants_and_equations_mod.f90
r4400 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4400 2020-02-10 20:32:41Z suehring 27 30 ! Move routine to transform coordinates from netcdf_interface_mod to 28 31 ! basic_constants_and_equations_mod … … 92 95 REAL(wp), PARAMETER :: g_d_cp = g / c_p !< precomputed g / c_p 93 96 REAL(wp), PARAMETER :: lv_d_cp = l_v / c_p !< precomputed l_v / c_p 97 REAL(wp), PARAMETER :: ls_d_cp = l_s / c_p !< precomputed l_s / c_p 94 98 REAL(wp), PARAMETER :: lv_d_rd = l_v / r_d !< precomputed l_v / r_d 95 99 REAL(wp), PARAMETER :: rd_d_rv = r_d / r_v !< precomputed r_d / r_v … … 106 110 PRIVATE magnus_0d, & 107 111 magnus_1d, & 112 magnus_tl_0d, & 113 magnus_tl_1d, & 114 magnus_0d_ice, & 115 magnus_1d_ice, & 108 116 ideal_gas_law_rho_0d, & 109 117 ideal_gas_law_rho_1d, & … … 126 134 MODULE PROCEDURE magnus_1d 127 135 END INTERFACE magnus 136 137 INTERFACE magnus_tl 138 MODULE PROCEDURE magnus_tl_0d 139 MODULE PROCEDURE magnus_tl_1d 140 END INTERFACE magnus_tl 141 142 INTERFACE magnus_ice 143 MODULE PROCEDURE magnus_0d_ice 144 MODULE PROCEDURE magnus_1d_ice 145 END INTERFACE magnus_ice 128 146 129 147 INTERFACE ideal_gas_law_rho … … 337 355 ! Description: 338 356 ! ------------ 357 !> This function computes the magnus formula (Press et al., 1992) using the 358 !> (ice-) liquid water potential temperature. 359 !> The magnus formula is needed to calculate the saturation vapor pressure over 360 !> a plane liquid water surface 361 !------------------------------------------------------------------------------! 362 FUNCTION magnus_tl_0d( t_l ) 363 364 IMPLICIT NONE 365 366 REAL(wp), INTENT(IN) :: t_l !< liquid water temperature (K) 367 368 REAL(wp) :: magnus_tl_0d 369 ! 370 !-- Saturation vapor pressure for a specific temperature: 371 magnus_tl_0d = 610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / & 372 ( t_l - 35.86_wp ) ) 373 374 END FUNCTION magnus_tl_0d 375 376 !------------------------------------------------------------------------------! 377 ! Description: 378 ! ------------ 379 !> This function computes the magnus formula (Press et al., 1992) using the 380 !> (ice-) liquid water potential temperature. 381 !> The magnus formula is needed to calculate the saturation vapor pressure over 382 !> a plane liquid water surface 383 !------------------------------------------------------------------------------! 384 FUNCTION magnus_tl_1d( t_l ) 385 386 IMPLICIT NONE 387 388 REAL(wp), INTENT(IN), DIMENSION(:) :: t_l !< liquid water temperature (K) 389 390 REAL(wp), DIMENSION(size(t_l)) :: magnus_tl_1d 391 ! 392 !-- Saturation vapor pressure for a specific temperature: 393 magnus_tl_1d = 610.78_wp * EXP( 17.269_wp * ( t_l - 273.16_wp ) / & 394 ( t_l - 35.86_wp ) ) 395 396 END FUNCTION magnus_tl_1d 397 398 !------------------------------------------------------------------------------! 399 ! Description: 400 ! ------------ 401 !> This function computes the magnus formula (Press et al., 1992). 402 !> The magnus formula is needed to calculate the saturation vapor pressure over 403 !> a plane ice surface 404 !------------------------------------------------------------------------------! 405 FUNCTION magnus_0d_ice( t ) 406 407 IMPLICIT NONE 408 409 REAL(wp), INTENT(IN) :: t !< temperature (K) 410 411 REAL(wp) :: magnus_0d_ice 412 ! 413 !-- Saturation vapor pressure for a specific temperature: 414 magnus_0d_ice = 611.2_wp * EXP( 22.46_wp * ( t - degc_to_k ) / & 415 ( t - 0.53_wp ) ) 416 417 END FUNCTION magnus_0d_ice 418 419 !------------------------------------------------------------------------------! 420 ! Description: 421 ! ------------ 422 !> This function computes the magnus formula (Press et al., 1992). 423 !> The magnus formula is needed to calculate the saturation vapor pressure over 424 !> a plane ice surface 425 !------------------------------------------------------------------------------! 426 FUNCTION magnus_1d_ice( t ) 427 428 IMPLICIT NONE 429 430 REAL(wp), INTENT(IN), DIMENSION(:) :: t !< temperature (K) 431 432 REAL(wp), DIMENSION(size(t)) :: magnus_1d_ice 433 ! 434 !-- Saturation vapor pressure for a specific temperature: 435 magnus_1d_ice = 611.2_wp * EXP( 22.46_wp * ( t - degc_to_k ) / & 436 ( t - 0.53_wp ) ) 437 438 END FUNCTION magnus_1d_ice 439 440 !------------------------------------------------------------------------------! 441 ! Description: 442 ! ------------ 339 443 !> Compute the ideal gas law for scalar arguments. 340 444 !------------------------------------------------------------------------------! -
palm/trunk/SOURCE/bulk_cloud_model_mod.f90
r4495 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4495 2020-04-13 20:11:20Z raasch 27 30 ! restart data handling with MPI-IO added 28 31 ! … … 116 119 precipitation_amount, prr, pt, d_exner, pt_init, q, ql, ql_1, & 117 120 qc, qc_1, qc_2, qc_3, qc_p, qr, qr_1, qr_2, qr_3, qr_p, & 118 exner, zu, tnc_m, tnr_m, tqc_m, tqr_m, tend, rdf_sc, & 119 flux_l_qc, flux_l_qr, flux_l_nc, flux_l_nr, & 120 flux_s_qc, flux_s_qr, flux_s_nc, flux_s_nr, & 121 diss_l_qc, diss_l_qr, diss_l_nc, diss_l_nr, & 122 diss_s_qc, diss_s_qr, diss_s_nc, diss_s_nr 121 exner, zu, tnc_m, tnr_m, tqc_m, tqr_m, tend, rdf_sc, & 122 flux_l_qc, flux_l_qr, flux_l_nc, flux_l_nr, & 123 flux_s_qc, flux_s_qr, flux_s_nc, flux_s_nr, & 124 diss_l_qc, diss_l_qr, diss_l_nc, diss_l_nr, & 125 diss_s_qc, diss_s_qr, diss_s_nc, diss_s_nr, & 126 ni, ni_1, ni_2, ni_3, ni_p, tni_m, & 127 qi, qi_1, qi_2, qi_3, qi_p, tqi_m, & 128 flux_l_qi, flux_l_ni, flux_s_qi, flux_s_ni, & 129 diss_l_qi, diss_l_ni, diss_s_qi, diss_s_ni 130 123 131 124 132 USE averaging, & 125 ONLY: nc_av, nr_av, prr_av, qc_av, ql_av, qr_av 133 ONLY: nc_av, nr_av, prr_av, qc_av, ql_av, qr_av, ni_av, qi_av 126 134 127 135 USE basic_constants_and_equations_mod, & 128 ONLY: c_p, g, lv_d_cp, lv_d_rd, l_v, magnus, molecular_weight_of_solute,& 136 ONLY: c_p, g, lv_d_cp, lv_d_rd, l_v, magnus, magnus_ice, & 137 molecular_weight_of_solute, & 129 138 molecular_weight_of_water, pi, rho_l, rho_s, r_d, r_v, vanthoff,& 130 139 exner_function, exner_function_invers, ideal_gas_law_rho, & 131 ideal_gas_law_rho_pt, barometric_formula, rd_d_rv 140 ideal_gas_law_rho_pt, barometric_formula, rd_d_rv, l_s, & 141 ls_d_cp 132 142 133 143 USE control_parameters, & … … 143 153 dt_3d, dt_do2d_xy, intermediate_timestep_count, & 144 154 intermediate_timestep_count_max, large_scale_forcing, & 145 lsf_surf, pt_surface, restart_data_format_output, rho_surface, surface_pressure, & 155 lsf_surf, pt_surface, restart_data_format_output, rho_surface, & 156 surface_pressure, & 146 157 time_do2d_xy, message_string, initializing_actions, & 147 ws_scheme_sca, scalar_advec, timestep_scheme, tsc, loop_optimization 158 ws_scheme_sca, scalar_advec, timestep_scheme, tsc, & 159 loop_optimization, simulated_time 148 160 149 161 USE cpulog, & … … 167 179 ONLY: threads_per_task 168 180 169 USE restart_data_mpi_io_mod, 181 USE restart_data_mpi_io_mod, & 170 182 ONLY: rrd_mpi_io, wrd_mpi_io 171 183 172 184 USE statistics, & 173 185 ONLY: weight_pres, weight_substep, sums_wsncs_ws_l, sums_wsnrs_ws_l, & 174 sums_wsqcs_ws_l, sums_wsqrs_ws_l 186 sums_wsqcs_ws_l, sums_wsqrs_ws_l, & 187 sums_wsqis_ws_l, sums_wsnis_ws_l 175 188 176 189 USE surface_mod, & 177 190 ONLY : bc_h, & 178 191 surf_bulk_cloud_model, & 179 surf_microphysics_morrison, surf_microphysics_seifert, & 180 surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v 192 surf_microphysics_morrison, surf_microphysics_seifert, & 193 surf_microphysics_ice_extension, & 194 surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, & 195 surf_usm_v 181 196 182 197 IMPLICIT NONE … … 193 208 LOGICAL :: cloud_water_sedimentation = .FALSE. !< cloud water sedimentation 194 209 LOGICAL :: curvature_solution_effects_bulk = .FALSE. !< flag for considering koehler theory 210 LOGICAL :: ice_crystal_sedimentation = .FALSE. !< flag for ice crystal sedimentation 195 211 LOGICAL :: limiter_sedimentation = .TRUE. !< sedimentation limiter 196 212 LOGICAL :: collision_turbulence = .FALSE. !< turbulence effects … … 198 214 199 215 LOGICAL :: call_microphysics_at_all_substeps = .FALSE. !< namelist parameter 216 LOGICAL :: microphysics_ice_extension = .FALSE. !< use ice microphysics scheme 200 217 LOGICAL :: microphysics_sat_adjust = .FALSE. !< use saturation adjust bulk scheme? 201 218 LOGICAL :: microphysics_kessler = .FALSE. !< use kessler bulk scheme? 202 219 LOGICAL :: microphysics_morrison = .FALSE. !< use 2-moment Morrison (add. prog. eq. for nc and qc) 203 220 LOGICAL :: microphysics_seifert = .FALSE. !< use 2-moment Seifert and Beheng scheme 204 LOGICAL :: microphysics_morrison_no_rain = .FALSE. !< use 2-moment Morrison 221 LOGICAL :: microphysics_morrison_no_rain = .FALSE. !< use 2-moment Morrison 205 222 LOGICAL :: precipitation = .FALSE. !< namelist parameter 206 223 … … 240 257 REAL(wp) :: w_precipitation = 9.65_wp !< maximum terminal velocity (m s-1) 241 258 REAL(wp) :: x0 = 2.6E-10_wp !< separating drop mass (kg) 242 ! REAL(wp) :: xamin = 5.24E-19_wp !< average aerosol mass (kg) (~ 0.05µm)259 REAL(wp) :: ximin = 4.42E-14_wp !< minimum mass of ice crystal (kg) (D~10µm) 243 260 REAL(wp) :: xcmin = 4.18E-15_wp !< minimum cloud drop size (kg) (~ 1µm) 244 261 REAL(wp) :: xrmin = 2.6E-10_wp !< minimum rain drop size (kg) … … 249 266 REAL(wp) :: dry_aerosol_radius = 0.05E-6_wp !< dry aerosol radius 250 267 REAL(wp) :: dt_micro !< microphysics time step 268 REAL(wp) :: in_init = 1000.0_wp !< initial number of potential ice nucleii 251 269 REAL(wp) :: sigma_bulk = 2.0_wp !< width of aerosol spectrum 252 270 REAL(wp) :: na_init = 100.0E6_wp !< Total particle/aerosol concentration (cm-3) … … 254 272 REAL(wp) :: dt_precipitation = 100.0_wp !< timestep precipitation (s) 255 273 REAL(wp) :: sed_qc_const !< const. for sedimentation of cloud water 256 REAL(wp) :: pirho_l !< pi * rho_l / 6.0; 274 REAL(wp) :: pirho_l !< pi * rho_l / 6.0 275 REAL(wp) :: start_ice_microphysics = 0.0_wp !< time from which on ice microhysics are executed 257 276 258 277 REAL(wp) :: e_s !< saturation water vapor pressure 278 REAL(wp) :: e_si !< saturation water vapor pressure over ice 259 279 REAL(wp) :: q_s !< saturation mixing ratio 280 REAL(wp) :: q_si !< saturation mixing ratio over ice 260 281 REAL(wp) :: sat !< supersaturation 261 REAL(wp) :: t_l !< actual temperature 282 REAL(wp) :: sat_ice !< supersaturation over ice 283 REAL(wp) :: t_l !< liquid-(ice) water temperature 262 284 263 285 SAVE … … 294 316 dt_precipitation, & 295 317 microphysics_morrison, & 296 microphysics_morrison_no_rain, & 318 microphysics_morrison_no_rain, & 297 319 microphysics_sat_adjust, & 298 320 microphysics_seifert, & 321 microphysics_ice_extension, & 299 322 na_init, & 300 323 nc_const, & 301 324 precipitation, & 302 sigma_gc 303 325 sigma_gc, & 326 start_ice_microphysics, & 327 ice_crystal_sedimentation, & 328 in_init 304 329 305 330 INTERFACE bcm_parin … … 420 445 nc_const, & 421 446 sigma_bulk, & 422 ventilation_effect 447 ventilation_effect, & 448 ice_crystal_sedimentation, & 449 microphysics_ice_extension, & 450 start_ice_microphysics, & 451 in_init 423 452 424 453 line = ' ' … … 517 546 microphysics_kessler = .FALSE. 518 547 microphysics_morrison = .TRUE. 519 microphysics_morrison_no_rain = .TRUE. 520 precipitation = .FALSE. 548 microphysics_morrison_no_rain = .TRUE. 549 precipitation = .FALSE. 521 550 ELSE 522 551 message_string = 'unknown cloud microphysics scheme cloud_scheme ="' // & … … 546 575 surf_microphysics_morrison = microphysics_morrison 547 576 surf_microphysics_seifert = microphysics_seifert 548 577 surf_microphysics_ice_extension = microphysics_ice_extension 549 578 ! 550 579 !-- Check aerosol … … 592 621 unit = '1/m3' 593 622 623 CASE ( 'ni' ) 624 IF ( .NOT. microphysics_ice_extension ) THEN 625 message_string = 'output of "' // TRIM( var ) // '" ' // & 626 'requires ' // & 627 'microphysics_ice_extension = ".TRUE."' 628 CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 ) 629 ENDIF 630 unit = '1/m3' 631 594 632 CASE ( 'nr' ) 595 633 IF ( .NOT. microphysics_seifert ) THEN … … 611 649 612 650 CASE ( 'qc' ) 651 unit = 'kg/kg' 652 653 CASE ( 'qi' ) 654 IF ( .NOT. microphysics_ice_extension ) THEN 655 message_string = 'output of "' // TRIM( var ) // '" ' // & 656 'requires ' // & 657 'microphysics_ice_extension = ".TRUE."' 658 CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 ) 659 ENDIF 613 660 unit = 'kg/kg' 614 661 … … 698 745 ENDIF 699 746 pr_index = 123 747 dopr_index(var_count) = pr_index 748 dopr_unit = '1/m3' 749 unit = dopr_unit 750 hom(:,2,pr_index,:) = SPREAD( zu, 2, statistic_regions+1 ) 751 752 CASE ( 'ni' ) 753 IF ( .NOT. microphysics_ice_extension ) THEN 754 message_string = 'data_output_pr = ' // & 755 TRIM( data_output_pr(var_count) ) // & 756 ' is not implemented for' // & 757 ' microphysics_ice_extension = ".F."' 758 CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 ) 759 ENDIF 760 pr_index = 124 700 761 dopr_index(var_count) = pr_index 701 762 dopr_unit = '1/m3' … … 730 791 unit = dopr_unit 731 792 hom(:,2,pr_index,:) = SPREAD( zu, 2, statistic_regions+1 ) 793 732 794 CASE ( 'qc' ) 733 795 pr_index = 75 796 dopr_index(var_count) = pr_index 797 dopr_unit = 'kg/kg' 798 unit = dopr_unit 799 hom(:,2,pr_index,:) = SPREAD( zu, 2, statistic_regions+1 ) 800 801 CASE ( 'qi' ) 802 IF ( .NOT. microphysics_ice_extension ) THEN 803 message_string = 'data_output_pr = ' // & 804 TRIM( data_output_pr(var_count) ) // & 805 ' is not implemented for' // & 806 ' microphysics_ice_extension = ".F."' 807 CALL message( 'check_parameters', 'PA0358', 1, 2, 0, 6, 0 ) 808 ENDIF 809 pr_index = 125 734 810 dopr_index(var_count) = pr_index 735 811 dopr_unit = 'kg/kg' … … 792 868 ! 793 869 !-- 3D-cloud drop water content, cloud drop concentration arrays 794 ALLOCATE( nc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &795 nc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &796 nc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &797 qc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &798 qc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &870 ALLOCATE( nc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 871 nc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 872 nc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 873 qc_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 874 qc_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 799 875 qc_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 800 876 ENDIF … … 803 879 ! 804 880 !-- 3D-rain water content, rain drop concentration arrays 805 ALLOCATE( nr_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &806 nr_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &807 nr_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &808 qr_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &809 qr_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), &881 ALLOCATE( nr_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 882 nr_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 883 nr_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 884 qr_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 885 qr_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 810 886 qr_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 811 887 ENDIF 812 888 889 IF ( microphysics_ice_extension ) THEN 890 ! 891 !-- 3D-cloud drop water content, cloud drop concentration arrays 892 ALLOCATE( ni_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 893 ni_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 894 ni_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 895 qi_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 896 qi_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg), & 897 qi_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 898 ENDIF 899 813 900 IF ( ws_scheme_sca ) THEN 814 815 901 IF ( microphysics_morrison ) THEN 816 902 ALLOCATE( sums_wsqcs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) … … 819 905 sums_wsncs_ws_l = 0.0_wp 820 906 ENDIF 821 822 907 IF ( microphysics_seifert ) THEN 823 908 ALLOCATE( sums_wsqrs_ws_l(nzb:nzt+1,0:threads_per_task-1) ) … … 826 911 sums_wsnrs_ws_l = 0.0_wp 827 912 ENDIF 828 913 IF ( microphysics_ice_extension ) THEN 914 ALLOCATE( sums_wsqis_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 915 ALLOCATE( sums_wsnis_ws_l(nzb:nzt+1,0:threads_per_task-1) ) 916 sums_wsqis_ws_l = 0.0_wp 917 sums_wsnis_ws_l = 0.0_wp 918 ENDIF 829 919 ENDIF 830 920 … … 835 925 !-- advection routines. 836 926 IF ( loop_optimization /= 'vector' ) THEN 837 838 927 IF ( ws_scheme_sca ) THEN 839 840 928 IF ( microphysics_morrison ) THEN 841 929 ALLOCATE( flux_s_qc(nzb+1:nzt,0:threads_per_task-1), & … … 848 936 diss_l_nc(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 849 937 ENDIF 850 851 938 IF ( microphysics_seifert ) THEN 852 939 ALLOCATE( flux_s_qr(nzb+1:nzt,0:threads_per_task-1), & … … 859 946 diss_l_nr(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 860 947 ENDIF 861 862 ENDIF 863 948 IF ( microphysics_ice_extension ) THEN 949 ALLOCATE( flux_s_qi(nzb+1:nzt,0:threads_per_task-1), & 950 diss_s_qi(nzb+1:nzt,0:threads_per_task-1), & 951 flux_s_ni(nzb+1:nzt,0:threads_per_task-1), & 952 diss_s_ni(nzb+1:nzt,0:threads_per_task-1) ) 953 ALLOCATE( flux_l_qi(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 954 diss_l_qi(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 955 flux_l_ni(nzb+1:nzt,nys:nyn,0:threads_per_task-1), & 956 diss_l_ni(nzb+1:nzt,nys:nyn,0:threads_per_task-1) ) 957 ENDIF 958 ENDIF 864 959 ENDIF 865 960 … … 878 973 nr => nr_1; nr_p => nr_2; tnr_m => nr_3 879 974 ENDIF 975 IF ( microphysics_ice_extension ) THEN 976 qi => qi_1; qi_p => qi_2; tqi_m => qi_3 977 ni => ni_1; ni_p => ni_2; tni_m => ni_3 978 ENDIF 979 880 980 881 981 … … 919 1019 ENDIF 920 1020 ! 1021 !-- Initialize the remaining quantities 1022 IF ( microphysics_ice_extension ) THEN 1023 DO i = nxlg, nxrg 1024 DO j = nysg, nyng 1025 qi(:,j,i) = 0.0_wp 1026 ni(:,j,i) = 0.0_wp 1027 ENDDO 1028 ENDDO 1029 ENDIF 1030 ! 921 1031 !-- Liquid water content and precipitation amount 922 1032 !-- are zero at beginning of the simulation … … 938 1048 qr_p = qr 939 1049 nr_p = nr 1050 ENDIF 1051 IF ( microphysics_ice_extension ) THEN 1052 tqi_m = 0.0_wp 1053 tni_m = 0.0_wp 1054 qi_p = qi 1055 ni_p = ni 940 1056 ENDIF 941 1057 ENDIF ! Only if not read_restart_data … … 1080 1196 sums_wsnrs_ws_l = 0.0_wp 1081 1197 ENDIF 1198 IF ( microphysics_ice_extension ) THEN 1199 sums_wsqis_ws_l = 0.0_wp 1200 sums_wsnis_ws_l = 0.0_wp 1201 ENDIF 1082 1202 1083 1203 ENDIF … … 1096 1216 !> Control of microphysics for grid points i,j 1097 1217 !------------------------------------------------------------------------------! 1098 1099 1218 SUBROUTINE bcm_actions_ij( i, j, location ) 1100 1219 … … 1121 1240 sums_wsnrs_ws_l = 0.0_wp 1122 1241 ENDIF 1242 IF ( microphysics_ice_extension ) THEN 1243 sums_wsqis_ws_l = 0.0_wp 1244 sums_wsnis_ws_l = 0.0_wp 1245 ENDIF 1246 1123 1247 1124 1248 ENDIF … … 1143 1267 CALL cpu_log( log_point(51), 'microphysics', 'start' ) 1144 1268 1145 IF ( .NOT. microphysics_sat_adjust .AND. &1146 ( intermediate_timestep_count == 1 .OR. 1147 call_microphysics_at_all_substeps ) ) 1269 IF ( .NOT. microphysics_sat_adjust .AND. & 1270 ( intermediate_timestep_count == 1 .OR. & 1271 call_microphysics_at_all_substeps ) ) & 1148 1272 THEN 1149 1273 … … 1151 1275 ! 1152 1276 !-- Calculate vertical profile of the hydrostatic pressure (hyp) 1153 hyp = barometric_formula(zu, pt_surface * exner_function(surface_pressure * 100.0_wp), surface_pressure * 100.0_wp) 1277 hyp = barometric_formula(zu, pt_surface * & 1278 exner_function(surface_pressure * 100.0_wp), & 1279 surface_pressure * 100.0_wp) 1154 1280 d_exner = exner_function_invers(hyp) 1155 1281 exner = 1.0_wp / exner_function_invers(hyp) 1156 hyrho = ideal_gas_law_rho_pt(hyp, pt _init)1282 hyrho = ideal_gas_law_rho_pt(hyp, pt(:, nys, nxl) ) 1157 1283 ! 1158 1284 !-- Compute reference density 1159 rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp, pt_surface * exner_function(surface_pressure * 100.0_wp)) 1285 rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp, & 1286 pt_surface * & 1287 exner_function(surface_pressure * 100.0_wp)) 1160 1288 ENDIF 1161 1289 … … 1178 1306 CALL autoconversion_kessler 1179 1307 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1180 1308 1181 1309 ! 1182 1310 !-- Here the seifert beheng scheme is used. Cloud concentration is assumed to … … 1184 1312 ELSEIF ( microphysics_seifert .AND. .NOT. microphysics_morrison ) THEN 1185 1313 CALL adjust_cloud 1314 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1315 CALL ice_nucleation 1316 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1317 CALL ice_deposition 1186 1318 CALL autoconversion 1187 1319 CALL accretion … … 1190 1322 CALL sedimentation_rain 1191 1323 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1192 1193 ! 1194 !-- Here the morrison scheme is used. No rain processes are considered and qr and nr 1324 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1325 CALL adjust_ice 1326 IF ( ice_crystal_sedimentation .AND. microphysics_ice_extension & 1327 .AND. simulated_time > start_ice_microphysics ) CALL sedimentation_ice 1328 1329 ! 1330 !-- Here the morrison scheme is used. No rain processes are considered and qr and nr 1195 1331 !-- are not allocated 1196 1332 ELSEIF ( microphysics_morrison_no_rain .AND. .NOT. microphysics_seifert ) THEN 1197 1333 CALL activation 1198 1334 CALL condensation 1199 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1200 1201 ! 1202 !-- Here the full morrison scheme is used and all processes of Seifert and Beheng are 1335 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1336 CALL adjust_ice 1337 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1338 CALL ice_nucleation 1339 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1340 CALL ice_deposition 1341 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1342 1343 ! 1344 !-- Here the full morrison scheme is used and all processes of Seifert and Beheng are 1203 1345 !-- included 1204 1346 ELSEIF ( microphysics_morrison .AND. microphysics_seifert ) THEN … … 1206 1348 CALL activation 1207 1349 CALL condensation 1350 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1351 CALL adjust_ice 1352 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1353 CALL ice_nucleation 1354 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1355 CALL ice_deposition 1208 1356 CALL autoconversion 1209 1357 CALL accretion … … 1211 1359 CALL evaporation_rain 1212 1360 CALL sedimentation_rain 1213 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1361 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud 1214 1362 1215 1363 ENDIF … … 1229 1377 !> Control of microphysics for grid points i,j 1230 1378 !------------------------------------------------------------------------------! 1231 1232 1379 SUBROUTINE bcm_non_advective_processes_ij( i, j ) 1233 1380 … … 1236 1383 INTEGER(iwp) :: j !< 1237 1384 1238 IF ( .NOT. microphysics_sat_adjust .AND. &1239 ( intermediate_timestep_count == 1 .OR. 1240 call_microphysics_at_all_substeps ) ) 1385 IF ( .NOT. microphysics_sat_adjust .AND. & 1386 ( intermediate_timestep_count == 1 .OR. & 1387 call_microphysics_at_all_substeps ) ) & 1241 1388 THEN 1242 1389 … … 1244 1391 ! 1245 1392 !-- Calculate vertical profile of the hydrostatic pressure (hyp) 1246 hyp = barometric_formula(zu, pt_surface * exner_function(surface_pressure * 100.0_wp), surface_pressure * 100.0_wp) 1393 hyp = barometric_formula(zu, pt_surface * & 1394 exner_function(surface_pressure * 100.0_wp), & 1395 surface_pressure * 100.0_wp) 1247 1396 d_exner = exner_function_invers(hyp) 1248 1397 exner = 1.0_wp / exner_function_invers(hyp) 1249 hyrho = ideal_gas_law_rho_pt(hyp, pt _init)1398 hyrho = ideal_gas_law_rho_pt(hyp, pt(:, nys, nxl) ) 1250 1399 ! 1251 1400 !-- Compute reference density 1252 rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp, pt_surface * exner_function(surface_pressure * 100.0_wp)) 1401 rho_surface = ideal_gas_law_rho(surface_pressure * 100.0_wp, & 1402 pt_surface * & 1403 exner_function(surface_pressure * 100.0_wp)) 1253 1404 ENDIF 1254 1405 … … 1273 1424 ! 1274 1425 !-- Here the seifert beheng scheme is used. Cloud concentration is assumed to 1275 !-- a constant value an qc a diagnostic value. 1426 !-- a constant value an qc a diagnostic value. 1276 1427 ELSEIF ( microphysics_seifert .AND. .NOT. microphysics_morrison ) THEN 1277 1428 CALL adjust_cloud_ij( i,j ) 1429 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1430 CALL ice_nucleation_ij( i,j ) 1431 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1432 CALL ice_deposition_ij( i,j ) 1278 1433 CALL autoconversion_ij( i,j ) 1279 1434 CALL accretion_ij( i,j ) … … 1282 1437 CALL sedimentation_rain_ij( i,j ) 1283 1438 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1284 1285 ! 1286 !-- Here the morrison scheme is used. No rain processes are considered and qr and nr 1439 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1440 CALL adjust_ice_ij ( i,j ) 1441 IF ( ice_crystal_sedimentation .AND. microphysics_ice_extension & 1442 .AND. simulated_time > start_ice_microphysics ) CALL sedimentation_ice_ij ( i,j ) 1443 ! 1444 !-- Here the morrison scheme is used. No rain processes are considered and qr and nr 1287 1445 !-- are not allocated 1288 1446 ELSEIF ( microphysics_morrison_no_rain .AND. .NOT. microphysics_seifert ) THEN 1289 1447 CALL activation_ij( i,j ) 1290 1448 CALL condensation_ij( i,j ) 1291 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1292 1293 ! 1294 !-- Here the full morrison scheme is used and all processes of Seifert and Beheng are 1295 !-- included 1449 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1450 CALL adjust_ice_ij ( i,j ) 1451 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1452 CALL ice_nucleation_ij( i,j ) 1453 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1454 CALL ice_deposition_ij( i,j ) 1455 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1456 1457 ! 1458 !-- Here the full morrison scheme is used and all processes of Seifert and Beheng are 1459 !-- included 1296 1460 ELSEIF ( microphysics_morrison .AND. microphysics_seifert ) THEN 1297 1461 CALL adjust_cloud_ij( i,j ) 1298 1462 CALL activation_ij( i,j ) 1299 1463 CALL condensation_ij( i,j ) 1464 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1465 CALL adjust_ice_ij ( i,j ) 1466 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1467 CALL ice_nucleation_ij( i,j ) 1468 IF ( microphysics_ice_extension .AND. simulated_time > start_ice_microphysics ) & 1469 CALL ice_deposition_ij( i,j ) 1300 1470 CALL autoconversion_ij( i,j ) 1301 1471 CALL accretion_ij( i,j ) … … 1303 1473 CALL evaporation_rain_ij( i,j ) 1304 1474 CALL sedimentation_rain_ij( i,j ) 1305 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1475 IF ( cloud_water_sedimentation ) CALL sedimentation_cloud_ij( i,j ) 1306 1476 1307 1477 ENDIF … … 1331 1501 IF ( microphysics_morrison ) THEN 1332 1502 CALL exchange_horiz( nc, nbgp ) 1333 CALL exchange_horiz( qc, nbgp ) 1503 CALL exchange_horiz( qc, nbgp ) 1334 1504 ENDIF 1335 1505 IF ( microphysics_seifert ) THEN … … 1337 1507 CALL exchange_horiz( nr, nbgp ) 1338 1508 ENDIF 1509 IF ( microphysics_ice_extension ) THEN 1510 CALL exchange_horiz( qi, nbgp ) 1511 CALL exchange_horiz( ni, nbgp ) 1512 ENDIF 1339 1513 CALL exchange_horiz( q, nbgp ) 1340 CALL exchange_horiz( pt, nbgp ) 1514 CALL exchange_horiz( pt, nbgp ) 1341 1515 ENDIF 1342 1516 1343 1517 1344 1518 END SUBROUTINE bcm_exchange_horiz 1345 1519 1346 1520 1347 1521 … … 1425 1599 ) & 1426 1600 * MERGE( 1.0_wp, 0.0_wp, & 1427 BTEST( wall_flags_total_0(k,j,i), 0 ) &1601 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1428 1602 ) 1429 1603 IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp … … 1517 1691 ) & 1518 1692 * MERGE( 1.0_wp, 0.0_wp, & 1519 BTEST( wall_flags_total_0(k,j,i), 0 ) &1693 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1520 1694 ) 1521 1695 IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp … … 1551 1725 1552 1726 ENDIF 1727 1728 ! 1729 !-- If required, calculate prognostic equations for ice crystal content 1730 !-- and ice crystal concentration 1731 IF ( microphysics_ice_extension ) THEN 1732 1733 CALL cpu_log( log_point(70), 'qi-equation', 'start' ) 1734 1735 ! 1736 !-- Calculate prognostic equation for ice crystal content 1737 sbt = tsc(2) 1738 IF ( scalar_advec == 'bc-scheme' ) THEN 1739 1740 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1741 ! 1742 !-- Bott-Chlond scheme always uses Euler time step. Thus: 1743 sbt = 1.0_wp 1744 ENDIF 1745 tend = 0.0_wp 1746 CALL advec_s_bc( qi, 'qi' ) 1747 1748 ENDIF 1749 1750 ! 1751 !-- qi-tendency terms with no communication 1752 IF ( scalar_advec /= 'bc-scheme' ) THEN 1753 tend = 0.0_wp 1754 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1755 IF ( ws_scheme_sca ) THEN 1756 CALL advec_s_ws( advc_flags_s, qi, 'qi', & 1757 bc_dirichlet_l .OR. bc_radiation_l, & 1758 bc_dirichlet_n .OR. bc_radiation_n, & 1759 bc_dirichlet_r .OR. bc_radiation_r, & 1760 bc_dirichlet_s .OR. bc_radiation_s ) 1761 ELSE 1762 CALL advec_s_pw( qi ) 1763 ENDIF 1764 ELSE 1765 CALL advec_s_up( qi ) 1766 ENDIF 1767 ENDIF 1768 1769 CALL diffusion_s( qi, & 1770 surf_def_h(0)%qisws, surf_def_h(1)%qisws, & 1771 surf_def_h(2)%qisws, & 1772 surf_lsm_h%qisws, surf_usm_h%qisws, & 1773 surf_def_v(0)%qisws, surf_def_v(1)%qisws, & 1774 surf_def_v(2)%qisws, surf_def_v(3)%qisws, & 1775 surf_lsm_v(0)%qisws, surf_lsm_v(1)%qisws, & 1776 surf_lsm_v(2)%qisws, surf_lsm_v(3)%qisws, & 1777 surf_usm_v(0)%qisws, surf_usm_v(1)%qisws, & 1778 surf_usm_v(2)%qisws, surf_usm_v(3)%qisws ) 1779 1780 ! 1781 !-- Prognostic equation for ice crystal mixing ratio 1782 DO i = nxl, nxr 1783 DO j = nys, nyn 1784 !following directive is required to vectorize on Intel19 1785 !DIR$ IVDEP 1786 DO k = nzb+1, nzt 1787 qi_p(k,j,i) = qi(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & 1788 tsc(3) * tqi_m(k,j,i) ) & 1789 - tsc(5) * rdf_sc(k) * & 1790 qi(k,j,i) & 1791 ) & 1792 * MERGE( 1.0_wp, 0.0_wp, & 1793 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1794 ) 1795 IF ( qi_p(k,j,i) < 0.0_wp ) qi_p(k,j,i) = 0.0_wp 1796 ENDDO 1797 ENDDO 1798 ENDDO 1799 1800 ! 1801 !-- Calculate tendencies for the next Runge-Kutta step 1802 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1803 IF ( intermediate_timestep_count == 1 ) THEN 1804 DO i = nxl, nxr 1805 DO j = nys, nyn 1806 DO k = nzb+1, nzt 1807 tqi_m(k,j,i) = tend(k,j,i) 1808 ENDDO 1809 ENDDO 1810 ENDDO 1811 ELSEIF ( intermediate_timestep_count < & 1812 intermediate_timestep_count_max ) THEN 1813 DO i = nxl, nxr 1814 DO j = nys, nyn 1815 DO k = nzb+1, nzt 1816 tqi_m(k,j,i) = -9.5625_wp * tend(k,j,i) & 1817 + 5.3125_wp * tqi_m(k,j,i) 1818 ENDDO 1819 ENDDO 1820 ENDDO 1821 ENDIF 1822 ENDIF 1823 1824 CALL cpu_log( log_point(70), 'qi-equation', 'stop' ) 1825 1826 CALL cpu_log( log_point(69), 'ni-equation', 'start' ) 1827 ! 1828 !-- Calculate prognostic equation for ice crystal concentration 1829 sbt = tsc(2) 1830 IF ( scalar_advec == 'bc-scheme' ) THEN 1831 1832 IF ( timestep_scheme(1:5) /= 'runge' ) THEN 1833 ! 1834 !-- Bott-Chlond scheme always uses Euler time step. Thus: 1835 sbt = 1.0_wp 1836 ENDIF 1837 tend = 0.0_wp 1838 CALL advec_s_bc( ni, 'ni' ) 1839 1840 ENDIF 1841 1842 ! 1843 !-- ni-tendency terms with no communication 1844 IF ( scalar_advec /= 'bc-scheme' ) THEN 1845 tend = 0.0_wp 1846 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1847 IF ( ws_scheme_sca ) THEN 1848 CALL advec_s_ws( advc_flags_s, ni, 'ni', & 1849 bc_dirichlet_l .OR. bc_radiation_l, & 1850 bc_dirichlet_n .OR. bc_radiation_n, & 1851 bc_dirichlet_r .OR. bc_radiation_r, & 1852 bc_dirichlet_s .OR. bc_radiation_s ) 1853 ELSE 1854 CALL advec_s_pw( ni ) 1855 ENDIF 1856 ELSE 1857 CALL advec_s_up( ni ) 1858 ENDIF 1859 ENDIF 1860 1861 CALL diffusion_s( ni, & 1862 surf_def_h(0)%nisws, surf_def_h(1)%nisws, & 1863 surf_def_h(2)%nisws, & 1864 surf_lsm_h%nisws, surf_usm_h%nisws, & 1865 surf_def_v(0)%nisws, surf_def_v(1)%nisws, & 1866 surf_def_v(2)%nisws, surf_def_v(3)%nisws, & 1867 surf_lsm_v(0)%nisws, surf_lsm_v(1)%nisws, & 1868 surf_lsm_v(2)%nisws, surf_lsm_v(3)%nisws, & 1869 surf_usm_v(0)%nisws, surf_usm_v(1)%nisws, & 1870 surf_usm_v(2)%nisws, surf_usm_v(3)%nisws ) 1871 1872 ! 1873 !-- Prognostic equation for ice crystal concentration 1874 DO i = nxl, nxr 1875 DO j = nys, nyn 1876 !following directive is required to vectorize on Intel19 1877 !DIR$ IVDEP 1878 DO k = nzb+1, nzt 1879 ni_p(k,j,i) = ni(k,j,i) + ( dt_3d * ( sbt * tend(k,j,i) + & 1880 tsc(3) * tni_m(k,j,i) ) & 1881 - tsc(5) * rdf_sc(k) * & 1882 ni(k,j,i) & 1883 ) & 1884 * MERGE( 1.0_wp, 0.0_wp, & 1885 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1886 ) 1887 IF ( ni_p(k,j,i) < 0.0_wp ) ni_p(k,j,i) = 0.0_wp 1888 ENDDO 1889 ENDDO 1890 ENDDO 1891 1892 ! 1893 !-- Calculate tendencies for the next Runge-Kutta step 1894 IF ( timestep_scheme(1:5) == 'runge' ) THEN 1895 IF ( intermediate_timestep_count == 1 ) THEN 1896 DO i = nxl, nxr 1897 DO j = nys, nyn 1898 DO k = nzb+1, nzt 1899 tni_m(k,j,i) = tend(k,j,i) 1900 ENDDO 1901 ENDDO 1902 ENDDO 1903 ELSEIF ( intermediate_timestep_count < & 1904 intermediate_timestep_count_max ) THEN 1905 DO i = nxl, nxr 1906 DO j = nys, nyn 1907 DO k = nzb+1, nzt 1908 tni_m(k,j,i) = -9.5625_wp * tend(k,j,i) & 1909 + 5.3125_wp * tni_m(k,j,i) 1910 ENDDO 1911 ENDDO 1912 ENDDO 1913 ENDIF 1914 ENDIF 1915 1916 CALL cpu_log( log_point(69), 'ni-equation', 'stop' ) 1917 1918 ENDIF 1919 1553 1920 ! 1554 1921 !-- If required, calculate prognostic equations for rain water content … … 1616 1983 ) & 1617 1984 * MERGE( 1.0_wp, 0.0_wp, & 1618 BTEST( wall_flags_total_0(k,j,i), 0 ) &1985 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1619 1986 ) 1620 1987 IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp … … 1708 2075 ) & 1709 2076 * MERGE( 1.0_wp, 0.0_wp, & 1710 BTEST( wall_flags_total_0(k,j,i), 0 ) &2077 BTEST( wall_flags_total_0(k,j,i), 0 ) & 1711 2078 ) 1712 2079 IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp … … 1751 2118 !> Control of microphysics for grid points i,j 1752 2119 !------------------------------------------------------------------------------! 1753 1754 2120 SUBROUTINE bcm_prognostic_equations_ij( i, j, i_omp_start, tn ) 1755 2121 … … 1805 2171 ) & 1806 2172 * MERGE( 1.0_wp, 0.0_wp, & 1807 BTEST( wall_flags_total_0(k,j,i), 0 )&2173 BTEST( wall_flags_total_0(k,j,i), 0 )& 1808 2174 ) 1809 2175 IF ( qc_p(k,j,i) < 0.0_wp ) qc_p(k,j,i) = 0.0_wp … … 1864 2230 ) & 1865 2231 * MERGE( 1.0_wp, 0.0_wp, & 1866 BTEST( wall_flags_total_0(k,j,i), 0 )&2232 BTEST( wall_flags_total_0(k,j,i), 0 )& 1867 2233 ) 1868 2234 IF ( nc_p(k,j,i) < 0.0_wp ) nc_p(k,j,i) = 0.0_wp … … 1885 2251 1886 2252 ENDIF 2253 2254 ! 2255 !-- If required, calculate prognostic equations for ice crystal mixing ratio 2256 !-- and ice crystal concentration 2257 IF ( microphysics_ice_extension ) THEN 2258 ! 2259 !-- Calculate prognostic equation for ice crystal mixing ratio 2260 tend(:,j,i) = 0.0_wp 2261 IF ( timestep_scheme(1:5) == 'runge' ) & 2262 THEN 2263 IF ( ws_scheme_sca ) THEN 2264 CALL advec_s_ws( advc_flags_s, i, j, qi, 'qi', flux_s_qi, & 2265 diss_s_qi, flux_l_qi, diss_l_qi, & 2266 i_omp_start, tn, & 2267 bc_dirichlet_l .OR. bc_radiation_l, & 2268 bc_dirichlet_n .OR. bc_radiation_n, & 2269 bc_dirichlet_r .OR. bc_radiation_r, & 2270 bc_dirichlet_s .OR. bc_radiation_s ) 2271 ELSE 2272 CALL advec_s_pw( i, j, qi ) 2273 ENDIF 2274 ELSE 2275 CALL advec_s_up( i, j, qi ) 2276 ENDIF 2277 CALL diffusion_s( i, j, qi, & 2278 surf_def_h(0)%qisws, surf_def_h(1)%qisws, & 2279 surf_def_h(2)%qisws, & 2280 surf_lsm_h%qisws, surf_usm_h%qisws, & 2281 surf_def_v(0)%qisws, surf_def_v(1)%qisws, & 2282 surf_def_v(2)%qisws, surf_def_v(3)%qisws, & 2283 surf_lsm_v(0)%qisws, surf_lsm_v(1)%qisws, & 2284 surf_lsm_v(2)%qisws, surf_lsm_v(3)%qisws, & 2285 surf_usm_v(0)%qisws, surf_usm_v(1)%qisws, & 2286 surf_usm_v(2)%qisws, surf_usm_v(3)%qisws ) 2287 2288 ! 2289 !-- Prognostic equation for ice crystal mixing ratio 2290 DO k = nzb+1, nzt 2291 qi_p(k,j,i) = qi(k,j,i) + ( dt_3d * & 2292 ( tsc(2) * tend(k,j,i) + & 2293 tsc(3) * tqi_m(k,j,i) )& 2294 - tsc(5) * rdf_sc(k) & 2295 * qi(k,j,i) & 2296 ) & 2297 * MERGE( 1.0_wp, 0.0_wp, & 2298 BTEST( wall_flags_total_0(k,j,i), 0 )& 2299 ) 2300 IF ( qi_p(k,j,i) < 0.0_wp ) qi_p(k,j,i) = 0.0_wp 2301 ENDDO 2302 ! 2303 !-- Calculate tendencies for the next Runge-Kutta step 2304 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2305 IF ( intermediate_timestep_count == 1 ) THEN 2306 DO k = nzb+1, nzt 2307 tqi_m(k,j,i) = tend(k,j,i) 2308 ENDDO 2309 ELSEIF ( intermediate_timestep_count < & 2310 intermediate_timestep_count_max ) THEN 2311 DO k = nzb+1, nzt 2312 tqi_m(k,j,i) = -9.5625_wp * tend(k,j,i) + & 2313 5.3125_wp * tqi_m(k,j,i) 2314 ENDDO 2315 ENDIF 2316 ENDIF 2317 2318 ! 2319 !-- Calculate prognostic equation for ice crystal concentration. 2320 tend(:,j,i) = 0.0_wp 2321 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2322 IF ( ws_scheme_sca ) THEN 2323 CALL advec_s_ws( advc_flags_s, i, j, ni, 'ni', flux_s_ni, & 2324 diss_s_ni, flux_l_ni, diss_l_ni, & 2325 i_omp_start, tn, & 2326 bc_dirichlet_l .OR. bc_radiation_l, & 2327 bc_dirichlet_n .OR. bc_radiation_n, & 2328 bc_dirichlet_r .OR. bc_radiation_r, & 2329 bc_dirichlet_s .OR. bc_radiation_s ) 2330 ELSE 2331 CALL advec_s_pw( i, j, ni ) 2332 ENDIF 2333 ELSE 2334 CALL advec_s_up( i, j, ni ) 2335 ENDIF 2336 CALL diffusion_s( i, j, ni, & 2337 surf_def_h(0)%nisws, surf_def_h(1)%nisws, & 2338 surf_def_h(2)%nisws, & 2339 surf_lsm_h%nisws, surf_usm_h%nisws, & 2340 surf_def_v(0)%nisws, surf_def_v(1)%nisws, & 2341 surf_def_v(2)%nisws, surf_def_v(3)%nisws, & 2342 surf_lsm_v(0)%nisws, surf_lsm_v(1)%nisws, & 2343 surf_lsm_v(2)%nisws, surf_lsm_v(3)%nisws, & 2344 surf_usm_v(0)%nisws, surf_usm_v(1)%nisws, & 2345 surf_usm_v(2)%nisws, surf_usm_v(3)%nisws ) 2346 2347 ! 2348 !-- Prognostic equation for ice crystal concentration 2349 DO k = nzb+1, nzt 2350 ni_p(k,j,i) = ni(k,j,i) + ( dt_3d * & 2351 ( tsc(2) * tend(k,j,i) + & 2352 tsc(3) * tni_m(k,j,i) )& 2353 - tsc(5) * rdf_sc(k) & 2354 * ni(k,j,i) & 2355 ) & 2356 * MERGE( 1.0_wp, 0.0_wp, & 2357 BTEST( wall_flags_total_0(k,j,i), 0 )& 2358 ) 2359 IF ( ni_p(k,j,i) < 0.0_wp ) ni_p(k,j,i) = 0.0_wp 2360 ENDDO 2361 ! 2362 !-- Calculate tendencies for the next Runge-Kutta step 2363 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2364 IF ( intermediate_timestep_count == 1 ) THEN 2365 DO k = nzb+1, nzt 2366 tni_m(k,j,i) = tend(k,j,i) 2367 ENDDO 2368 ELSEIF ( intermediate_timestep_count < & 2369 intermediate_timestep_count_max ) THEN 2370 DO k = nzb+1, nzt 2371 tni_m(k,j,i) = -9.5625_wp * tend(k,j,i) + & 2372 5.3125_wp * tni_m(k,j,i) 2373 ENDDO 2374 ENDIF 2375 ENDIF 2376 2377 ENDIF 2378 1887 2379 ! 1888 2380 !-- If required, calculate prognostic equations for rain water content … … 1929 2421 ) & 1930 2422 * MERGE( 1.0_wp, 0.0_wp, & 1931 BTEST( wall_flags_total_0(k,j,i), 0 )&2423 BTEST( wall_flags_total_0(k,j,i), 0 )& 1932 2424 ) 1933 2425 IF ( qr_p(k,j,i) < 0.0_wp ) qr_p(k,j,i) = 0.0_wp … … 1988 2480 ) & 1989 2481 * MERGE( 1.0_wp, 0.0_wp, & 1990 BTEST( wall_flags_total_0(k,j,i), 0 )&2482 BTEST( wall_flags_total_0(k,j,i), 0 )& 1991 2483 ) 1992 2484 IF ( nr_p(k,j,i) < 0.0_wp ) nr_p(k,j,i) = 0.0_wp … … 2038 2530 nr => nr_1; nr_p => nr_2 2039 2531 ENDIF 2532 IF ( microphysics_ice_extension ) THEN 2533 qi => qi_1; qi_p => qi_2 2534 ni => ni_1; ni_p => ni_2 2535 ENDIF 2040 2536 2041 2537 CASE ( 1 ) … … 2049 2545 nr => nr_2; nr_p => nr_1 2050 2546 ENDIF 2547 IF ( microphysics_ice_extension ) THEN 2548 qi => qi_2; qi_p => qi_1 2549 ni => ni_2; ni_p => ni_1 2550 ENDIF 2551 2051 2552 2052 2553 END SELECT … … 2093 2594 ENDIF 2094 2595 2596 IF ( microphysics_ice_extension ) THEN 2597 ! 2598 !-- Surface conditions ice crysral (Dirichlet) 2599 !-- Run loop over all non-natural and natural walls. Note, in wall-datatype 2600 !-- the k coordinate belongs to the atmospheric grid point, therefore, set 2601 !-- qr_p and nr_p at upward (k-1) and downward-facing (k+1) walls 2602 DO l = 0, 1 2603 !$OMP PARALLEL DO PRIVATE( i, j, k ) 2604 DO m = 1, bc_h(l)%ns 2605 i = bc_h(l)%i(m) 2606 j = bc_h(l)%j(m) 2607 k = bc_h(l)%k(m) 2608 qi_p(k+bc_h(l)%koff,j,i) = 0.0_wp 2609 ni_p(k+bc_h(l)%koff,j,i) = 0.0_wp 2610 ENDDO 2611 ENDDO 2612 ! 2613 !-- Top boundary condition for ice crystal (Dirichlet) 2614 qi_p(nzt+1,:,:) = 0.0_wp 2615 ni_p(nzt+1,:,:) = 0.0_wp 2616 2617 ENDIF 2618 2619 2095 2620 IF ( microphysics_seifert ) THEN 2096 2621 ! … … 2129 2654 nr_p(:,nys-1,:) = nr_p(:,nys,:) 2130 2655 ENDIF 2656 IF ( microphysics_ice_extension ) THEN 2657 qi_p(:,nys-1,:) = qi_p(:,nys,:) 2658 ni_p(:,nys-1,:) = ni_p(:,nys,:) 2659 ENDIF 2131 2660 ELSEIF ( bc_radiation_n ) THEN 2132 2661 IF ( microphysics_morrison ) THEN … … 2138 2667 nr_p(:,nyn+1,:) = nr_p(:,nyn,:) 2139 2668 ENDIF 2669 IF ( microphysics_ice_extension ) THEN 2670 qi_p(:,nyn+1,:) = qi_p(:,nyn,:) 2671 ni_p(:,nyn+1,:) = ni_p(:,nyn,:) 2672 ENDIF 2140 2673 ELSEIF ( bc_radiation_l ) THEN 2141 2674 IF ( microphysics_morrison ) THEN … … 2147 2680 nr_p(:,:,nxl-1) = nr_p(:,:,nxl) 2148 2681 ENDIF 2682 IF ( microphysics_ice_extension ) THEN 2683 qi_p(:,:,nxl-1) = qi_p(:,:,nxl) 2684 ni_p(:,:,nxl-1) = ni_p(:,:,nxl) 2685 ENDIF 2149 2686 ELSEIF ( bc_radiation_r ) THEN 2150 2687 IF ( microphysics_morrison ) THEN … … 2155 2692 qr_p(:,:,nxr+1) = qr_p(:,:,nxr) 2156 2693 nr_p(:,:,nxr+1) = nr_p(:,:,nxr) 2694 ENDIF 2695 IF ( microphysics_ice_extension ) THEN 2696 qi_p(:,:,nxr+1) = qi_p(:,:,nxr) 2697 ni_p(:,:,nxr+1) = ni_p(:,:,nxr) 2157 2698 ENDIF 2158 2699 ENDIF … … 2433 2974 ENDIF 2434 2975 to_be_resorted => nc_av 2976 ENDIF 2977 IF ( mode == 'xy' ) grid = 'zu' 2978 2979 CASE ( 'ni_xy', 'ni_xz', 'ni_yz' ) 2980 IF ( av == 0 ) THEN 2981 to_be_resorted => ni 2982 ELSE 2983 IF ( .NOT. ALLOCATED( ni_av ) ) THEN 2984 ALLOCATE( ni_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 2985 ni_av = REAL( fill_value, KIND = wp ) 2986 ENDIF 2987 to_be_resorted => ni_av 2435 2988 ENDIF 2436 2989 IF ( mode == 'xy' ) grid = 'zu' … … 2499 3052 IF ( mode == 'xy' ) grid = 'zu' 2500 3053 3054 CASE ( 'qi_xy', 'qi_xz', 'qi_yz' ) 3055 IF ( av == 0 ) THEN 3056 to_be_resorted => qi 3057 ELSE 3058 IF ( .NOT. ALLOCATED( qi_av ) ) THEN 3059 ALLOCATE( qi_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3060 qi_av = REAL( fill_value, KIND = wp ) 3061 ENDIF 3062 to_be_resorted => qi_av 3063 ENDIF 3064 IF ( mode == 'xy' ) grid = 'zu' 3065 2501 3066 CASE ( 'ql_xy', 'ql_xz', 'ql_yz' ) 2502 3067 IF ( av == 0 ) THEN … … 2534 3099 DO k = nzb_do, nzt_do 2535 3100 local_pf(i,j,k) = MERGE( & 2536 to_be_resorted(k,j,i), 2537 REAL( fill_value, KIND = wp ), 2538 BTEST( wall_flags_total_0(k,j,i), flag_nr ) &3101 to_be_resorted(k,j,i), & 3102 REAL( fill_value, KIND = wp ), & 3103 BTEST( wall_flags_total_0(k,j,i), flag_nr ) & 2539 3104 ) 2540 3105 ENDDO … … 2595 3160 ENDIF 2596 3161 to_be_resorted => nc_av 3162 ENDIF 3163 3164 CASE ( 'ni' ) 3165 IF ( av == 0 ) THEN 3166 to_be_resorted => ni 3167 ELSE 3168 IF ( .NOT. ALLOCATED( ni_av ) ) THEN 3169 ALLOCATE( ni_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3170 ni_av = REAL( fill_value, KIND = wp ) 3171 ENDIF 3172 to_be_resorted => ni_av 2597 3173 ENDIF 2598 3174 … … 2643 3219 ENDIF 2644 3220 3221 CASE ( 'qi' ) 3222 IF ( av == 0 ) THEN 3223 to_be_resorted => qi 3224 ELSE 3225 IF ( .NOT. ALLOCATED( qi_av ) ) THEN 3226 ALLOCATE( qi_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3227 qi_av = REAL( fill_value, KIND = wp ) 3228 ENDIF 3229 to_be_resorted => qi_av 3230 ENDIF 3231 2645 3232 CASE ( 'ql' ) 2646 3233 IF ( av == 0 ) THEN … … 2675 3262 DO j = nys, nyn 2676 3263 DO k = nzb_do, nzt_do 2677 local_pf(i,j,k) = MERGE( 2678 to_be_resorted(k,j,i), 2679 REAL( fill_value, KIND = wp ), 2680 BTEST( wall_flags_total_0(k,j,i), flag_nr ) &3264 local_pf(i,j,k) = MERGE( & 3265 to_be_resorted(k,j,i), & 3266 REAL( fill_value, KIND = wp ), & 3267 BTEST( wall_flags_total_0(k,j,i), flag_nr ) & 2681 3268 ) 2682 3269 ENDDO … … 2750 3337 CASE ( 'curvature_solution_effects_bulk' ) 2751 3338 READ ( 13 ) curvature_solution_effects_bulk 3339 3340 CASE ( 'microphysics_ice_extension' ) 3341 READ ( 13 ) microphysics_ice_extension 3342 3343 CASE ( 'ice_crystal_sedimentation' ) 3344 READ ( 13 ) ice_crystal_sedimentation 3345 3346 CASE ( 'in_init' ) 3347 READ ( 13 ) in_init 3348 3349 CASE ( 'start_ice_microphysics' ) 3350 READ ( 13 ) start_ice_microphysics 2752 3351 2753 3352 CASE DEFAULT … … 2782 3381 CALL rrd_mpi_io( 'aerosol_bulk', aerosol_bulk ) 2783 3382 CALL rrd_mpi_io( 'curvature_solution_effects_bulk', curvature_solution_effects_bulk ) 3383 CALL rrd_mpi_io( 'start_ice_microphysics', start_ice_microphysics ) 3384 CALL rrd_mpi_io( 'microphysics_ice_extension', microphysics_ice_extension ) 3385 CALL rrd_mpi_io( 'in_init', in_init ) 3386 CALL rrd_mpi_io( 'ice_crystal_sedimentation', ice_crystal_sedimentation ) 3387 3388 2784 3389 2785 3390 END SUBROUTINE bcm_rrd_global_mpi … … 2846 3451 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 2847 3452 3453 CASE ( 'ni' ) 3454 IF ( k == 1 ) READ ( 13 ) tmp_3d 3455 ni(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3456 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3457 3458 CASE ( 'ni_av' ) 3459 IF ( .NOT. ALLOCATED( ni_av ) ) THEN 3460 ALLOCATE( ni_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3461 ENDIF 3462 IF ( k == 1 ) READ ( 13 ) tmp_3d 3463 ni_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3464 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3465 2848 3466 CASE ( 'nr' ) 2849 3467 IF ( k == 1 ) READ ( 13 ) tmp_3d … … 2886 3504 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 2887 3505 3506 CASE ( 'qi' ) 3507 IF ( k == 1 ) READ ( 13 ) tmp_3d 3508 qi(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3509 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3510 3511 CASE ( 'qi_av' ) 3512 IF ( .NOT. ALLOCATED( qi_av ) ) THEN 3513 ALLOCATE( qi_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 3514 ENDIF 3515 IF ( k == 1 ) READ ( 13 ) tmp_3d 3516 qi_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 3517 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 3518 2888 3519 CASE ( 'qc_av' ) 2889 3520 IF ( .NOT. ALLOCATED( qc_av ) ) THEN … … 2984 3615 CALL wrd_write_string( 'curvature_solution_effects_bulk' ) 2985 3616 WRITE ( 14 ) curvature_solution_effects_bulk 3617 3618 CALL wrd_write_string( 'start_ice_microphysics' ) 3619 WRITE ( 14 ) start_ice_microphysics 3620 3621 CALL wrd_write_string( 'microphysics_ice_extension' ) 3622 WRITE ( 14 ) microphysics_ice_extension 3623 3624 CALL wrd_write_string( 'in_init' ) 3625 WRITE ( 14 ) in_init 3626 3627 CALL wrd_write_string( 'ice_crystal_sedimentation' ) 3628 WRITE ( 14 ) ice_crystal_sedimentation 2986 3629 2987 3630 ELSEIF ( TRIM( restart_data_format_output ) == 'mpi' ) THEN … … 3001 3644 CALL wrd_mpi_io( 'aerosol_bulk', aerosol_bulk ) 3002 3645 CALL wrd_mpi_io( 'curvature_solution_effects_bulk', curvature_solution_effects_bulk ) 3646 CALL wrd_mpi_io( 'start_ice_microphysics', start_ice_microphysics ) 3647 CALL wrd_mpi_io( 'microphysics_ice_extension', microphysics_ice_extension ) 3648 CALL wrd_mpi_io( 'in_init', in_init ) 3649 CALL wrd_mpi_io( 'ice_crystal_sedimentation', ice_crystal_sedimentation ) 3003 3650 3004 3651 ENDIF … … 3062 3709 3063 3710 ENDIF 3711 3712 IF ( microphysics_ice_extension ) THEN 3713 3714 CALL wrd_write_string( 'ni' ) 3715 WRITE ( 14 ) ni 3716 3717 IF ( ALLOCATED( ni_av ) ) THEN 3718 CALL wrd_write_string( 'ni_av' ) 3719 WRITE ( 14 ) ni_av 3720 ENDIF 3721 3722 CALL wrd_write_string( 'qi' ) 3723 WRITE ( 14 ) qi 3724 3725 IF ( ALLOCATED( qi_av ) ) THEN 3726 CALL wrd_write_string( 'qi_av' ) 3727 WRITE ( 14 ) qi_av 3728 ENDIF 3729 3730 ENDIF 3731 3064 3732 3065 3733 IF ( microphysics_seifert ) THEN … … 3104 3772 IF ( ALLOCATED( qr_av ) ) CALL wrd_mpi_io( 'qr_av', qr_av ) 3105 3773 ENDIF 3774 IF ( microphysics_ice_extension ) THEN 3775 CALL wrd_mpi_io( 'ni', ni ) 3776 IF ( ALLOCATED( ni_av ) ) CALL wrd_mpi_io( 'ni_av', ni_av ) 3777 CALL wrd_mpi_io( 'qi', qi ) 3778 IF ( ALLOCATED( qi_av ) ) CALL wrd_mpi_io( 'qi_av', qi_av ) 3779 ENDIF 3106 3780 3107 3781 ENDIF … … 3134 3808 !-- Predetermine flag to mask topography 3135 3809 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3136 3137 IF ( qr(k,j,i) <= eps_sb ) THEN 3138 qr(k,j,i) = 0.0_wp 3139 nr(k,j,i) = 0.0_wp 3140 ELSE 3141 IF ( nr(k,j,i) * xrmin > qr(k,j,i) * hyrho(k) ) THEN 3142 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin * flag 3143 ELSEIF ( nr(k,j,i) * xrmax < qr(k,j,i) * hyrho(k) ) THEN 3144 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax * flag 3810 IF ( .NOT. microphysics_morrison_no_rain ) THEN 3811 IF ( qr(k,j,i) <= eps_sb ) THEN 3812 qr(k,j,i) = 0.0_wp 3813 nr(k,j,i) = 0.0_wp 3814 ELSE 3815 IF ( nr(k,j,i) * xrmin > qr(k,j,i) * hyrho(k) ) THEN 3816 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin * flag 3817 ELSEIF ( nr(k,j,i) * xrmax < qr(k,j,i) * hyrho(k) ) THEN 3818 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax * flag 3819 ENDIF 3145 3820 ENDIF 3146 3821 ENDIF … … 3189 3864 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3190 3865 3191 IF ( qr(k,j,i) <= eps_sb ) THEN 3192 qr(k,j,i) = 0.0_wp 3193 nr(k,j,i) = 0.0_wp 3194 ELSE 3195 ! 3196 !-- Adjust number of raindrops to avoid nonlinear effects in 3197 !-- sedimentation and evaporation of rain drops due to too small or 3198 !-- too big weights of rain drops (Stevens and Seifert, 2008). 3199 IF ( nr(k,j,i) * xrmin > qr(k,j,i) * hyrho(k) ) THEN 3200 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin * flag 3201 ELSEIF ( nr(k,j,i) * xrmax < qr(k,j,i) * hyrho(k) ) THEN 3202 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax * flag 3203 ENDIF 3204 3866 IF ( .NOT. microphysics_morrison_no_rain ) THEN 3867 IF ( qr(k,j,i) <= eps_sb ) THEN 3868 qr(k,j,i) = 0.0_wp 3869 nr(k,j,i) = 0.0_wp 3870 ELSE 3871 ! 3872 !-- Adjust number of raindrops to avoid nonlinear effects in 3873 !-- sedimentation and evaporation of rain drops due to too small or 3874 !-- too big weights of rain drops (Stevens and Seifert, 2008). 3875 IF ( nr(k,j,i) * xrmin > qr(k,j,i) * hyrho(k) ) THEN 3876 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmin * flag 3877 ELSEIF ( nr(k,j,i) * xrmax < qr(k,j,i) * hyrho(k) ) THEN 3878 nr(k,j,i) = qr(k,j,i) * hyrho(k) / xrmax * flag 3879 ENDIF 3880 ENDIF 3205 3881 ENDIF 3206 3882 … … 3219 3895 3220 3896 END SUBROUTINE adjust_cloud_ij 3897 3898 !------------------------------------------------------------------------------! 3899 ! Description: 3900 ! ------------ 3901 !> Adjust number of ice crystal to avoid nonlinear effects in sedimentation and 3902 !> evaporation of ice crytals due to too small or too big weights 3903 !> of ice crytals (Stevens and Seifert, 2008). 3904 !------------------------------------------------------------------------------! 3905 SUBROUTINE adjust_ice 3906 3907 IMPLICIT NONE 3908 3909 INTEGER(iwp) :: i !< 3910 INTEGER(iwp) :: j !< 3911 INTEGER(iwp) :: k !< 3912 3913 REAL(wp) :: flag !< flag to indicate first grid level above 3914 3915 CALL cpu_log( log_point_s(97), 'adjust_ice', 'start' ) 3916 3917 DO i = nxl, nxr 3918 DO j = nys, nyn 3919 DO k = nzb+1, nzt 3920 ! 3921 !-- Predetermine flag to mask topography 3922 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3923 IF ( qi(k,j,i) <= ximin ) THEN 3924 qi(k,j,i) = 0.0_wp 3925 ni(k,j,i) = 0.0_wp 3926 ELSE 3927 IF ( ni(k,j,i) * ximin > qi(k,j,i) * hyrho(k) ) THEN 3928 ni(k,j,i) = qi(k,j,i) * hyrho(k) / ximin * flag 3929 ENDIF 3930 ENDIF 3931 ENDDO 3932 ENDDO 3933 ENDDO 3934 3935 CALL cpu_log( log_point_s(97), 'adjust_ice', 'stop' ) 3936 3937 END SUBROUTINE adjust_ice 3938 3939 !------------------------------------------------------------------------------! 3940 ! Description: 3941 ! ------------ 3942 !> Adjust number of of ice crystal to avoid nonlinear effects in 3943 !> sedimentation and evaporation of ice crystals due to too small or 3944 !> too big weights of ice crytals (Stevens and Seifert, 2008). 3945 !> The same procedure is applied to cloud droplets if they are determined 3946 !> prognostically. Call for grid point i,j 3947 !------------------------------------------------------------------------------! 3948 SUBROUTINE adjust_ice_ij( i, j ) 3949 3950 IMPLICIT NONE 3951 3952 INTEGER(iwp) :: i !< 3953 INTEGER(iwp) :: j !< 3954 INTEGER(iwp) :: k !< 3955 3956 REAL(wp) :: flag !< flag to indicate first grid level above surface 3957 3958 DO k = nzb+1, nzt 3959 ! 3960 !-- Predetermine flag to mask topography 3961 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 3962 IF ( qi(k,j,i) <= ximin ) THEN 3963 qi(k,j,i) = 0.0_wp 3964 ni(k,j,i) = 0.0_wp 3965 ELSE 3966 IF ( ni(k,j,i) * ximin > qi(k,j,i) * hyrho(k) ) THEN 3967 ni(k,j,i) = qi(k,j,i) * hyrho(k) / ximin * flag 3968 ENDIF 3969 ENDIF 3970 ENDDO 3971 3972 END SUBROUTINE adjust_ice_ij 3973 3221 3974 3222 3975 !------------------------------------------------------------------------------! … … 3423 4176 END SUBROUTINE activation_ij 3424 4177 4178 !------------------------------------------------------------------------------! 4179 ! Description: 4180 ! ------------ 4181 !> Calculate ice nucleation by applying the deposition-condensation formula as 4182 !> given by Meyers et al 1992 and as described in Seifert and Beheng 2006 4183 !------------------------------------------------------------------------------! 4184 SUBROUTINE ice_nucleation 4185 4186 INTEGER(iwp) :: i !< loop index 4187 INTEGER(iwp) :: j !< loop index 4188 INTEGER(iwp) :: k !< loop index 4189 4190 LOGICAL :: isdac = .TRUE. 4191 4192 REAL(wp) :: a_m92 = -0.639_wp !< parameter for nucleation 4193 REAL(wp) :: b_m92 = 12.96_wp !< parameter for nucleation 4194 REAL(wp) :: flag !< flag to indicate first grid level 4195 REAL(wp) :: n_in !< number of ice nucleii 4196 REAL(wp) :: nucle = 0.0_wp !< nucleation rate 4197 4198 CALL cpu_log( log_point_s(93), 'ice_nucleation', 'start' ) 4199 4200 IF ( isdac ) THEN 4201 DO i = nxl, nxr 4202 DO j = nys, nyn 4203 DO k = nzb+1, nzt 4204 ! 4205 !-- Predetermine flag to mask topography 4206 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4207 ! 4208 !-- Call calculation of supersaturation located in subroutine 4209 CALL supersaturation_ice ( i, j, k ) 4210 nucle = 0.0_wp 4211 !IF ( zu(k) >= 1500.0_wp ) CYCLE 4212 IF ( sat_ice >= 0.05_wp .OR. ql(k,j,i) >= 0.001E-3_wp ) THEN 4213 ! 4214 !-- Calculate ice nucleation 4215 nucle = MAX( ( in_init - ni(k,j,i) ) / dt_micro, 0.0_wp ) 4216 !qi(k,j,i) = qi(k,j,i) + nucle * dt_micro * ximin 4217 ni(k,j,i) = MIN( (ni(k,j,i) + nucle * dt_micro * flag), in_init) 4218 ENDIF 4219 4220 ENDDO 4221 ENDDO 4222 ENDDO 4223 ELSE 4224 DO i = nxl, nxr 4225 DO j = nys, nyn 4226 DO k = nzb+1, nzt 4227 ! 4228 !-- Predetermine flag to mask topography 4229 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4230 ! 4231 !-- Call calculation of supersaturation located in subroutine 4232 CALL supersaturation_ice ( i, j, k ) 4233 nucle = 0.0_wp 4234 IF ( sat_ice > 0.0 ) THEN 4235 ! 4236 !-- Calculate ice nucleation 4237 n_in = in_init * EXP( a_m92 + b_m92 * sat_ice ) 4238 nucle = MAX( ( n_in - ni(k,j,i) ) / dt_micro, 0.0_wp ) 4239 ENDIF 4240 ni(k,j,i) = MIN( (ni(k,j,i) + nucle * dt_micro * flag), 1.0E10_wp ) 4241 ENDDO 4242 ENDDO 4243 ENDDO 4244 ENDIF 4245 4246 CALL cpu_log( log_point_s(93), 'ice_nucleation', 'stop' ) 4247 4248 END SUBROUTINE ice_nucleation 4249 4250 4251 !------------------------------------------------------------------------------! 4252 ! Description: 4253 ! ------------ 4254 !> Calculate ice nucleation by applying the deposition-condensation formula as 4255 !> given by Meyers et al 1992 and as described in Seifert and Beheng 2006 4256 !------------------------------------------------------------------------------! 4257 SUBROUTINE ice_nucleation_ij( i, j ) 4258 4259 INTEGER(iwp) :: i !< loop index 4260 INTEGER(iwp) :: j !< loop index 4261 INTEGER(iwp) :: k !< loop index 4262 4263 LOGICAL :: isdac = .TRUE. 4264 4265 REAL(wp) :: a_m92 = -0.639_wp !< parameter for nucleation 4266 REAL(wp) :: b_m92 = 12.96_wp !< parameter for nucleation 4267 REAL(wp) :: flag !< flag to indicate first grid level 4268 REAL(wp) :: n_in !< number of ice nucleii 4269 REAL(wp) :: nucle = 0.0_wp !< nucleation rate 4270 4271 IF ( isdac ) THEN 4272 DO k = nzb+1, nzt 4273 ! 4274 !-- Predetermine flag to mask topography 4275 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4276 ! 4277 !-- Call calculation of supersaturation located in subroutine 4278 CALL supersaturation_ice ( i, j, k ) 4279 nucle = 0.0_wp 4280 !IF ( zu(k) >= 1500.0_wp ) CYCLE 4281 IF ( sat_ice >= 0.05_wp .OR. ql(k,j,i) >= 0.001E-3_wp ) THEN 4282 ! 4283 !-- Calculate ice nucleation 4284 nucle = MAX( ( in_init - ni(k,j,i) ) / dt_micro, 0.0_wp ) 4285 !qi(k,j,i) = qi(k,j,i) + nucle * dt_micro * ximin 4286 ni(k,j,i) = MIN( (ni(k,j,i) + nucle * dt_micro * flag), in_init) 4287 ENDIF 4288 ENDDO 4289 ELSE 4290 DO k = nzb+1, nzt 4291 ! 4292 !-- Predetermine flag to mask topography 4293 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4294 ! 4295 !-- Call calculation of supersaturation located in subroutine 4296 CALL supersaturation_ice ( i, j, k ) 4297 nucle = 0.0_wp 4298 IF ( sat_ice > 0.0 ) THEN 4299 ! 4300 !-- Calculate ice nucleation 4301 n_in = in_init * EXP( a_m92 + b_m92 * sat_ice ) 4302 nucle = MAX( ( n_in - ni(k,j,i) ) / dt_micro, 0.0_wp ) 4303 ENDIF 4304 ni(k,j,i) = MIN( (ni(k,j,i) + nucle * dt_micro * flag), 1.0E10_wp ) 4305 ENDDO 4306 ENDIF 4307 4308 4309 END SUBROUTINE ice_nucleation_ij 3425 4310 3426 4311 !------------------------------------------------------------------------------! … … 3434 4319 IMPLICIT NONE 3435 4320 3436 INTEGER(iwp) :: i !< 3437 INTEGER(iwp) :: j !< 3438 INTEGER(iwp) :: k !< 3439 3440 REAL(wp) :: cond !< 3441 REAL(wp) :: cond_max !< 3442 REAL(wp) :: dc !< 3443 REAL(wp) :: evap !< 3444 REAL(wp) :: g_fac !< 3445 REAL(wp) :: nc_0 !< 3446 REAL(wp) :: temp !< 3447 REAL(wp) :: xc !< 3448 3449 REAL(wp) :: flag !< flag to indicate first grid level above 4321 INTEGER(iwp) :: i !< loop index 4322 INTEGER(iwp) :: j !< loop index 4323 INTEGER(iwp) :: k !< loop index 4324 4325 REAL(wp) :: cond !< condensation rate 4326 REAL(wp) :: cond_max !< maximum condensation rate 4327 REAL(wp) :: dc !< weight avageraed diameter 4328 REAL(wp) :: evap !< evaporation rate 4329 REAL(wp) :: flag !< flag to indicate first grid level above surface 4330 REAL(wp) :: g_fac !< factor 1 / Fk + Fd 4331 REAL(wp) :: nc_0 !< integral diameter 4332 REAL(wp) :: temp !< actual temperature 4333 REAL(wp) :: xc !< mean mass droplets 3450 4334 3451 4335 CALL cpu_log( log_point_s(66), 'condensation', 'start' ) … … 3461 4345 CALL supersaturation ( i, j, k ) 3462 4346 ! 3463 !-- Actual temperature: 3464 IF ( microphysics_seifert ) THEN 3465 temp = t_l + lv_d_cp * ( qc(k,j,i) + qr(k,j,i) ) 3466 ELSEIF ( microphysics_morrison_no_rain ) THEN 3467 temp = t_l + lv_d_cp * qc(k,j,i) 3468 ENDIF 4347 !-- Actual temperature, t_l is calculated directly before 4348 !-- in supersaturation 4349 IF ( microphysics_ice_extension ) THEN 4350 temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qi(k,j,i) 4351 ELSE 4352 temp = t_l + lv_d_cp * ql(k,j,i) 4353 ENDIF 3469 4354 3470 4355 g_fac = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) * & … … 3525 4410 IMPLICIT NONE 3526 4411 3527 INTEGER(iwp) :: i !< 3528 INTEGER(iwp) :: j !< 3529 INTEGER(iwp) :: k !< 3530 3531 REAL(wp) :: cond !< 3532 REAL(wp) :: cond_max !< 3533 REAL(wp) :: dc !< 3534 REAL(wp) :: evap !< 4412 INTEGER(iwp) :: i !< loop index 4413 INTEGER(iwp) :: j !< loop index 4414 INTEGER(iwp) :: k !< loop index 4415 4416 REAL(wp) :: cond !< condensation rate 4417 REAL(wp) :: cond_max !< maximum condensation rate 4418 REAL(wp) :: dc !< weight avageraed diameter 4419 REAL(wp) :: evap !< evaporation rate 3535 4420 REAL(wp) :: flag !< flag to indicate first grid level above surface 3536 REAL(wp) :: g_fac !< 3537 REAL(wp) :: nc_0 !< 3538 REAL(wp) :: temp !< 3539 REAL(wp) :: xc !< 3540 4421 REAL(wp) :: g_fac !< factor 1 / Fk + Fd 4422 REAL(wp) :: nc_0 !< integral diameter 4423 REAL(wp) :: temp !< actual temperature 4424 REAL(wp) :: xc !< mean mass droplets 3541 4425 3542 4426 DO k = nzb+1, nzt … … 3548 4432 CALL supersaturation ( i, j, k ) 3549 4433 ! 3550 !-- Actual temperature: 3551 IF ( microphysics_seifert ) THEN 3552 temp = t_l + lv_d_cp * ( qc(k,j,i) + qr(k,j,i) ) 3553 ELSEIF ( microphysics_morrison_no_rain ) THEN 3554 temp = t_l + lv_d_cp * qc(k,j,i) 3555 ENDIF 3556 3557 g_fac = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) * & 3558 l_v / ( thermal_conductivity_l * temp ) & 3559 + r_v * temp / ( diff_coeff_l * e_s ) & 4434 !-- Actual temperature, t_l is calculated directly before 4435 !-- in supersaturation 4436 IF ( microphysics_ice_extension ) THEN 4437 temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qi(k,j,i) 4438 ELSE 4439 temp = t_l + lv_d_cp * ql(k,j,i) 4440 ENDIF 4441 4442 g_fac = 1.0_wp / ( ( l_v / ( r_v * temp ) - 1.0_wp ) * & 4443 l_v / ( thermal_conductivity_l * temp ) & 4444 + r_v * temp / ( diff_coeff_l * e_s ) & 3560 4445 ) 3561 4446 ! … … 3594 4479 3595 4480 END SUBROUTINE condensation_ij 4481 4482 !------------------------------------------------------------------------------! 4483 ! Description: 4484 ! ------------ 4485 !> Calculate the growth of ice particles by water vapor deposition (after 4486 !> Seifert and Beheng, 2006). 4487 !------------------------------------------------------------------------------! 4488 SUBROUTINE ice_deposition 4489 4490 INTEGER(iwp) :: i !< loop index 4491 INTEGER(iwp) :: j !< loop index 4492 INTEGER(iwp) :: k !< loop index 4493 4494 REAL(wp) :: ac = 0.09_wp !< parameter for ice capacitance 4495 REAL(wp) :: bc = 0.33_wp !< parameter for ice capacitance 4496 REAL(wp) :: fac_gamma = 0.76_wp !< parameter to describe spectral 4497 !< distribution, here following gamma 4498 !< size distribution with µ =1/3 and nu=0 4499 REAL(wp) :: deposition_rate !< depositions rate 4500 REAL(wp) :: deposition_rate_max !< maximum deposition rate 4501 REAL(wp) :: sublimation_rate !< sublimations rate 4502 REAL(wp) :: gfac_dep !< factor 4503 REAL(wp) :: temp !< actual temperature 4504 REAL(wp) :: xi !< mean mass of ice crystal 4505 REAL(wp) :: flag !< flag to indicate first grid level above 4506 4507 CALL cpu_log( log_point_s(95), 'ice deposition', 'start' ) 4508 4509 DO i = nxl, nxr 4510 DO j = nys, nyn 4511 DO k = nzb+1, nzt 4512 ! 4513 !-- Predetermine flag to mask topography 4514 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4515 ! 4516 !-- Call calculation of supersaturation over a plane ice surface 4517 CALL supersaturation_ice ( i, j, k ) 4518 ! 4519 !-- Actual temperature: 4520 temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qi(k,j,i) 4521 4522 IF ( temp >= 273.15_wp ) CYCLE 4523 ! 4524 !-- calculating gfac_dep ( 1/ (Fk + Fd) ) see e.g. 4525 !-- Rogers and Yau, 1989 4526 gfac_dep = 1.0_wp / ( ( l_s / ( r_v * temp ) - 1.0_wp ) * & 4527 l_s / ( thermal_conductivity_l * temp ) & 4528 + r_v * temp / ( diff_coeff_l * e_si ) & 4529 ) 4530 ! 4531 !-- If there is nothing nucleated, than there is also no 4532 !-- deposition (above -38°C) 4533 IF ( ni(k,j,i) <= 0.0_wp ) CYCLE 4534 ! 4535 !-- calculate mean mass of ice crystal 4536 xi = 0.0_wp 4537 xi = MAX( ( qi(k,j,i) * hyrho(k) / ni(k,j,i)), ximin ) 4538 ! 4539 !-- Condensation needs only to be calculated in supersaturated 4540 !-- regions (regarding ice) 4541 IF ( sat_ice > 0.0_wp ) THEN 4542 ! 4543 !-- Calculate deposition rate assuming ice crystal shape as 4544 !-- prescribed in Ovchinnikov et al., 2014 and a gamma size 4545 !-- distribution according to Seifert and Beheng with to 4546 !-- µ =1/3 and nu=0 4547 deposition_rate = 4.0_wp * pi * sat_ice * gfac_dep * & 4548 fac_gamma * ac * xi**bc * ni(k,j,i) 4549 IF ( microphysics_seifert ) THEN 4550 deposition_rate_max = q(k,j,i) - & 4551 q_si - qr(k,j,i) - qi(k,j,i) 4552 ELSEIF ( microphysics_morrison_no_rain ) THEN 4553 deposition_rate_max = q(k,j,i) - & 4554 q_si - qc(k,j,i) - qi(k,j,i) 4555 ENDIF 4556 deposition_rate = MIN( deposition_rate, & 4557 deposition_rate_max / dt_micro ) 4558 4559 qi(k,j,i) = qi(k,j,i) + deposition_rate * dt_micro * flag 4560 ELSEIF ( sat_ice < 0.0_wp ) THEN 4561 sublimation_rate = 4.0_wp * pi * sat_ice * gfac_dep * & 4562 fac_gamma * ac * xi**bc * ni(k,j,i) 4563 sublimation_rate = MAX( sublimation_rate, & 4564 -qi(k,j,i) / dt_micro ) 4565 qi(k,j,i) = qi(k,j,i) + sublimation_rate * dt_micro * flag 4566 ENDIF 4567 ENDDO 4568 ENDDO 4569 ENDDO 4570 4571 CALL cpu_log( log_point_s(95), 'ice deposition', 'stop' ) 4572 4573 END SUBROUTINE ice_deposition 4574 4575 !------------------------------------------------------------------------------! 4576 ! Description: 4577 ! ------------ 4578 !> Calculate condensation rate for cloud water content (after Khairoutdinov and 4579 !> Kogan, 2000). 4580 !------------------------------------------------------------------------------! 4581 SUBROUTINE ice_deposition_ij( i, j ) 4582 4583 INTEGER(iwp) :: i !< loop index 4584 INTEGER(iwp) :: j !< loop index 4585 INTEGER(iwp) :: k !< loop index 4586 4587 REAL(wp) :: ac = 0.09_wp !< parameter for ice capacitance 4588 REAL(wp) :: bc = 0.33_wp !< parameter for ice capacitance 4589 REAL(wp) :: fac_gamma = 0.76_wp !< parameter to describe spectral 4590 !< distribution, here following gamma 4591 !< size distribution with nu=1, v=0 4592 REAL(wp) :: deposition_rate !< depositions rate 4593 REAL(wp) :: deposition_rate_max !< maximum deposition rate 4594 REAL(wp) :: sublimation_rate !< sublimations rate 4595 REAL(wp) :: gfac_dep !< factor 4596 REAL(wp) :: temp !< actual temperature 4597 REAL(wp) :: xi !< mean mass of ice crystal 4598 REAL(wp) :: flag !< flag to indicate first grid level above 4599 4600 DO k = nzb+1, nzt 4601 ! 4602 !-- Predetermine flag to mask topography 4603 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 4604 ! 4605 !-- Call calculation of supersaturation over a plane ice surface 4606 CALL supersaturation_ice ( i, j, k ) 4607 ! 4608 !-- Actual temperature: 4609 temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qi(k,j,i) 4610 4611 IF ( temp >= 273.15_wp ) CYCLE 4612 ! 4613 !-- calculating gfac_dep ( 1/ (Fk + Fd) ) see e.g. 4614 !-- Rogers and Yau, 1989 4615 gfac_dep = 1.0_wp / ( ( l_s / ( r_v * temp ) - 1.0_wp ) * & 4616 l_s / ( thermal_conductivity_l * temp ) & 4617 + r_v * temp / ( diff_coeff_l * e_si ) & 4618 ) 4619 ! 4620 !-- If there is nothing nucleated, than there is also no 4621 !-- deposition (above -38°C) 4622 IF ( ni(k,j,i) <= 0.0_wp ) CYCLE 4623 ! 4624 !-- calculate mean mass of ice crystal 4625 xi = 0.0_wp 4626 xi = MAX( ( qi(k,j,i) * hyrho(k) / ni(k,j,i)), ximin ) 4627 ! 4628 !-- Condensation needs only to be calculated in supersaturated 4629 !-- regions (regarding ice) 4630 IF ( sat_ice > 0.0_wp ) THEN 4631 ! 4632 !-- Calculate deposition rate assuming ice crystal shape as 4633 !-- prescribed in Ovchinnikov et al., 2014 and a gamma size 4634 !-- distribution according to Seifert and Beheng with to 4635 !-- µ =1/3 and nu=0 4636 deposition_rate = 4.0_wp * pi * sat_ice * gfac_dep * & 4637 fac_gamma * ac * xi**bc * ni(k,j,i) 4638 IF ( microphysics_seifert ) THEN 4639 deposition_rate_max = q(k,j,i) - & 4640 q_si - qr(k,j,i) - qi(k,j,i) 4641 ELSEIF ( microphysics_morrison_no_rain ) THEN 4642 deposition_rate_max = q(k,j,i) - & 4643 q_si - qc(k,j,i) - qi(k,j,i) 4644 ENDIF 4645 deposition_rate = MIN( deposition_rate, & 4646 deposition_rate_max / dt_micro ) 4647 4648 qi(k,j,i) = qi(k,j,i) + deposition_rate * dt_micro * flag 4649 ELSEIF ( sat_ice < 0.0_wp ) THEN 4650 sublimation_rate = 4.0_wp * pi * sat_ice * gfac_dep * & 4651 fac_gamma * ac * xi**bc * ni(k,j,i) 4652 sublimation_rate = MAX( sublimation_rate, & 4653 -qi(k,j,i) / dt_micro ) 4654 qi(k,j,i) = qi(k,j,i) + sublimation_rate * dt_micro * flag 4655 ENDIF 4656 ENDDO 4657 4658 END SUBROUTINE ice_deposition_ij 3596 4659 3597 4660 … … 3823 4886 !-- Autoconversion rate (Seifert and Beheng, 2006): 3824 4887 autocon = k_au * ( nu_c + 2.0_wp ) * ( nu_c + 4.0_wp ) / & 3825 ( nu_c + 1.0_wp )**2 * qc(k,j,i)**2 * xc**2 * 4888 ( nu_c + 1.0_wp )**2 * qc(k,j,i)**2 * xc**2 * & 3826 4889 ( 1.0_wp + phi_au / ( 1.0_wp - tau_cloud )**2 ) * & 3827 4890 rho_surface … … 4055 5118 ENDIF 4056 5119 4057 IF ( ( qc(k,j,i) > eps_sb ) .AND. ( qr(k,j,i) > eps_sb ) .AND. &5120 IF ( ( qc(k,j,i) > eps_sb ) .AND. ( qr(k,j,i) > eps_sb ) .AND. & 4058 5121 ( nc_accr > eps_mr ) ) THEN 4059 5122 ! … … 4082 5145 ! 4083 5146 !-- Accretion rate (Seifert and Beheng, 2006): 4084 accr = k_cr * qc(k,j,i) * qr(k,j,i) * phi_ac * 5147 accr = k_cr * qc(k,j,i) * qr(k,j,i) * phi_ac * & 4085 5148 SQRT( rho_surface * hyrho(k) ) 4086 5149 accr = MIN( accr, qc(k,j,i) / dt_micro ) … … 4089 5152 qc(k,j,i) = qc(k,j,i) - accr * dt_micro * flag 4090 5153 IF ( microphysics_morrison ) THEN 4091 nc(k,j,i) = nc(k,j,i) - MIN( nc(k,j,i), accr / xc * 5154 nc(k,j,i) = nc(k,j,i) - MIN( nc(k,j,i), accr / xc * & 4092 5155 hyrho(k) * dt_micro * flag & 4093 5156 ) … … 4587 5650 IF ( qc(k,j,i) > eps_sb .AND. nc(k,j,i) > eps_mr ) THEN 4588 5651 sed_nc(k) = sed_qc_const * & 4589 ( qc(k,j,i) * hyrho(k) )**( 2.0_wp / 3.0_wp ) * 5652 ( qc(k,j,i) * hyrho(k) )**( 2.0_wp / 3.0_wp ) * & 4590 5653 ( nc(k,j,i) )**( 1.0_wp / 3.0_wp ) 4591 5654 ELSE … … 4594 5657 4595 5658 sed_nc(k) = MIN( sed_nc(k), hyrho(k) * dzu(k+1) * & 4596 nc(k,j,i) / dt_micro + sed_nc(k+1) 5659 nc(k,j,i) / dt_micro + sed_nc(k+1) & 4597 5660 ) * flag 4598 5661 4599 nc(k,j,i) = nc(k,j,i) + ( sed_nc(k+1) - sed_nc(k) ) * 5662 nc(k,j,i) = nc(k,j,i) + ( sed_nc(k+1) - sed_nc(k) ) * & 4600 5663 ddzu(k+1) / hyrho(k) * dt_micro * flag 4601 5664 ENDIF … … 4608 5671 ENDIF 4609 5672 4610 sed_qc(k) = MIN( sed_qc(k), hyrho(k) * dzu(k+1) * q(k,j,i) / 5673 sed_qc(k) = MIN( sed_qc(k), hyrho(k) * dzu(k+1) * q(k,j,i) / & 4611 5674 dt_micro + sed_qc(k+1) & 4612 5675 ) * flag 4613 5676 4614 q(k,j,i) = q(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / 5677 q(k,j,i) = q(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / & 4615 5678 hyrho(k) * dt_micro * flag 4616 qc(k,j,i) = qc(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / 5679 qc(k,j,i) = qc(k,j,i) + ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / & 4617 5680 hyrho(k) * dt_micro * flag 4618 pt(k,j,i) = pt(k,j,i) - ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / 5681 pt(k,j,i) = pt(k,j,i) - ( sed_qc(k+1) - sed_qc(k) ) * ddzu(k+1) / & 4619 5682 hyrho(k) * lv_d_cp * d_exner(k) * dt_micro & 4620 5683 * flag … … 4632 5695 4633 5696 END SUBROUTINE sedimentation_cloud_ij 5697 5698 !------------------------------------------------------------------------------! 5699 ! Description: 5700 ! ------------ 5701 !> Sedimentation of ice crystals 5702 !------------------------------------------------------------------------------! 5703 SUBROUTINE sedimentation_ice 5704 5705 INTEGER(iwp) :: i !< loop index 5706 INTEGER(iwp) :: j !< loop index 5707 INTEGER(iwp) :: k !< loop index 5708 5709 REAL(wp) :: flag !< flag to indicate first grid level 5710 REAL(wp) :: av = 6.39_wp !< parameter for calculating fall speed 5711 REAL(wp) :: bv = 0.1666_wp !< parameter (1/6) 5712 REAL(wp) :: xi = 0.0_wp !< mean mass of ice crystal 5713 REAL(wp) :: vi = 0.0_wp !< mean fall speed of ice crystal 5714 REAL(wp) :: factor_sed_gamma_k0 = 0.76_wp !< factor for zeroth moment and 5715 !< µ =1/3 and nu=0 5716 REAL(wp) :: factor_sed_gamma_k1 = 1.61_wp !< factor for first moment and 5717 !< µ =1/3 and nu=0 5718 5719 REAL(wp), DIMENSION(nzb:nzt+1) :: sed_ni !< sedimentation rate zeroth moment 5720 REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qi !< sedimentation rate fist moment 5721 5722 CALL cpu_log( log_point_s(96), 'sed_ice', 'start' ) 5723 5724 sed_qi(nzt+1) = 0.0_wp 5725 sed_ni(nzt+1) = 0.0_wp 5726 5727 DO i = nxl, nxr 5728 DO j = nys, nyn 5729 DO k = nzt, nzb+1, -1 5730 5731 IF ( ni(k,j,i) <= 0.0_wp ) THEN 5732 xi = 0.0_wp 5733 ELSE 5734 !-- Calculate mean mass of ice crystal 5735 xi = MAX( (hyrho(k) * qi(k,j,i) / ni(k,j,i)), ximin) 5736 ENDIF 5737 ! 5738 !-- calculate fall speed of ice crystal 5739 vi = av * xi**bv 5740 ! 5741 !-- Predetermine flag to mask topography 5742 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5743 ! 5744 !-- Calculate sedimentation rate for each grid box, factors are 5745 !-- calculated using 5746 IF ( qi(k,j,i) > eps_sb .AND. ni(k,j,i) >= 0.0_wp ) THEN 5747 sed_qi(k) = qi(k,j,i) * vi * factor_sed_gamma_k1 * flag 5748 sed_ni(k) = ni(k,j,i) * vi * factor_sed_gamma_k0 * flag 5749 ELSE 5750 sed_qi(k) = 0.0_wp 5751 sed_ni(k) = 0.0_wp 5752 ENDIF 5753 ! 5754 !-- Calculate sedimentation: divergence of sedimentation flux 5755 sed_qi(k) = MIN( sed_qi(k), hyrho(k) * dzu(k+1) * q(k,j,i) / & 5756 dt_micro + sed_qi(k+1) & 5757 ) * flag 5758 5759 q(k,j,i) = q(k,j,i) + ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1)& 5760 / hyrho(k) * dt_micro * flag 5761 qi(k,j,i) = qi(k,j,i) + ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1)& 5762 / hyrho(k) * dt_micro * flag 5763 ni(k,j,i) = ni(k,j,i) + ( sed_ni(k+1) - sed_ni(k) ) * ddzu(k+1)& 5764 / hyrho(k) * dt_micro * flag 5765 5766 pt(k,j,i) = pt(k,j,i) - ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1)& 5767 / hyrho(k) * l_s / c_p * d_exner(k) * & 5768 dt_micro * flag 5769 ! 5770 !-- Compute the precipitation rate of cloud (fog) droplets 5771 IF ( call_microphysics_at_all_substeps ) THEN 5772 prr(k,j,i) = prr(k,j,i) + sed_qi(k) / hyrho(k) * & 5773 weight_substep(intermediate_timestep_count) * & 5774 flag 5775 ELSE 5776 prr(k,j,i) = prr(k,j,i) + sed_qi(k) / hyrho(k) * flag 5777 ENDIF 5778 5779 ENDDO 5780 ENDDO 5781 ENDDO 5782 5783 CALL cpu_log( log_point_s(96), 'sed_ice', 'stop' ) 5784 5785 END SUBROUTINE sedimentation_ice 5786 5787 5788 !------------------------------------------------------------------------------! 5789 ! Description: 5790 ! ------------ 5791 !> Sedimentation of ice crystals 5792 !------------------------------------------------------------------------------! 5793 SUBROUTINE sedimentation_ice_ij( i, j ) 5794 5795 INTEGER(iwp) :: i !< 5796 INTEGER(iwp) :: j !< 5797 INTEGER(iwp) :: k !< 5798 5799 REAL(wp) :: flag !< flag to indicate first grid level 5800 REAL(wp) :: av = 6.39_wp !< parameter for calculating fall speed 5801 REAL(wp) :: bv = 0.1666_wp !< 5802 REAL(wp) :: xi = 0.0_wp !< mean mass of ice crystal 5803 REAL(wp) :: vi = 0.0_wp !< mean fall speed of ice crystal 5804 REAL(wp) :: factor_sed_gamma_k0 = 0.76_wp 5805 REAL(wp) :: factor_sed_gamma_k1 = 1.61_wp 5806 5807 REAL(wp), DIMENSION(nzb:nzt+1) :: sed_ni !< 5808 REAL(wp), DIMENSION(nzb:nzt+1) :: sed_qi !< 5809 5810 sed_qi(nzt+1) = 0.0_wp 5811 sed_ni(nzt+1) = 0.0_wp 5812 5813 DO k = nzt, nzb+1, -1 5814 IF ( ni(k,j,i) <= 0.0_wp ) THEN 5815 xi = 0.0_wp 5816 ELSE 5817 !-- Calculate mean mass of ice crystal 5818 xi = MAX( (hyrho(k) * qi(k,j,i) / ni(k,j,i)), ximin) 5819 ENDIF 5820 ! 5821 !-- calculate fall speed of ice crystal 5822 vi = av * xi**bv 5823 ! 5824 !-- Predetermine flag to mask topography 5825 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5826 ! 5827 !-- Calculate sedimentation rate for each grid box, factors are 5828 !-- calculated using 5829 IF ( qi(k,j,i) > eps_sb .AND. ni(k,j,i) >= 0.0_wp ) THEN 5830 sed_qi(k) = qi(k,j,i) * vi * factor_sed_gamma_k1 * flag 5831 sed_ni(k) = ni(k,j,i) * vi * factor_sed_gamma_k0 * flag 5832 ELSE 5833 sed_qi(k) = 0.0_wp 5834 sed_ni(k) = 0.0_wp 5835 ENDIF 5836 ! 5837 !-- calculate fall speed of ice crystal 5838 vi = av * xi**bv 5839 ! 5840 !-- Predetermine flag to mask topography 5841 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5842 5843 IF ( qi(k,j,i) > eps_sb .AND. ni(k,j,i) >= 0.0_wp ) THEN 5844 sed_qi(k) = qi(k,j,i) * vi * factor_sed_gamma_k1 * flag 5845 sed_ni(k) = ni(k,j,i) * vi * factor_sed_gamma_k0 * flag 5846 ELSE 5847 sed_qi(k) = 0.0_wp 5848 sed_ni(k) = 0.0_wp 5849 ENDIF 5850 5851 sed_qi(k) = MIN( sed_qi(k), hyrho(k) * dzu(k+1) * q(k,j,i) / & 5852 dt_micro + sed_qi(k+1) & 5853 ) * flag 5854 5855 q(k,j,i) = q(k,j,i) + ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1) / & 5856 hyrho(k) * dt_micro * flag 5857 qi(k,j,i) = qi(k,j,i) + ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1) / & 5858 hyrho(k) * dt_micro * flag 5859 ni(k,j,i) = ni(k,j,i) + ( sed_ni(k+1) - sed_ni(k) ) * ddzu(k+1) / & 5860 hyrho(k) * dt_micro * flag 5861 pt(k,j,i) = pt(k,j,i) - ( sed_qi(k+1) - sed_qi(k) ) * ddzu(k+1) / & 5862 hyrho(k) * l_s / c_p * d_exner(k) * dt_micro & 5863 * flag 5864 ! 5865 !-- Compute the precipitation rate of cloud (fog) droplets 5866 IF ( call_microphysics_at_all_substeps ) THEN 5867 prr(k,j,i) = prr(k,j,i) + sed_qi(k) / hyrho(k) * & 5868 weight_substep(intermediate_timestep_count) * flag 5869 ELSE 5870 prr(k,j,i) = prr(k,j,i) + sed_qi(k) / hyrho(k) * flag 5871 ENDIF 5872 5873 ENDDO 5874 5875 END SUBROUTINE sedimentation_ice_ij 5876 4634 5877 4635 5878 … … 5053 6296 5054 6297 sed_nr(k) = flux / dt_micro * flag 5055 nr(k,j,i) = nr(k,j,i) + ( sed_nr(k+1) - sed_nr(k) ) * ddzu(k+1) / 6298 nr(k,j,i) = nr(k,j,i) + ( sed_nr(k+1) - sed_nr(k) ) * ddzu(k+1) / & 5056 6299 hyrho(k) * dt_micro * flag 5057 6300 ! … … 5080 6323 sed_qr(k) = flux / dt_micro * flag 5081 6324 5082 qr(k,j,i) = qr(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / 6325 qr(k,j,i) = qr(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / & 5083 6326 hyrho(k) * dt_micro * flag 5084 q(k,j,i) = q(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / 6327 q(k,j,i) = q(k,j,i) + ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / & 5085 6328 hyrho(k) * dt_micro * flag 5086 pt(k,j,i) = pt(k,j,i) - ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / 6329 pt(k,j,i) = pt(k,j,i) - ( sed_qr(k+1) - sed_qr(k) ) * ddzu(k+1) / & 5087 6330 hyrho(k) * lv_d_cp * d_exner(k) * dt_micro & 5088 6331 * flag … … 5202 6445 !-- (see: Cuijpers + Duynkerke, 1993, JAS, 23) 5203 6446 q_s = q_s * ( 1.0_wp + alpha * q(k,j,i) ) / ( 1.0_wp + alpha * q_s ) 6447 6448 IF ( .NOT. microphysics_ice_extension ) THEN 6449 IF ( microphysics_seifert ) THEN 6450 sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 6451 ELSEIF ( microphysics_morrison_no_rain ) THEN 6452 sat = ( q(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 6453 ENDIF 6454 ELSE 6455 IF ( microphysics_seifert ) THEN 6456 sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) - qi(k,j,i) ) / q_s - 1.0_wp 6457 ELSEIF ( microphysics_morrison_no_rain ) THEN 6458 sat = ( q(k,j,i) - qc(k,j,i) - qi(k,j,i) ) / q_s - 1.0_wp 6459 ENDIF 6460 ENDIF 6461 6462 END SUBROUTINE supersaturation 6463 6464 !------------------------------------------------------------------------------! 6465 ! Description: 6466 ! ------------ 6467 !> Computation of the diagnostic supersaturation sat, actual liquid water 6468 !< temperature t_l and saturation water vapor mixing ratio q_s 6469 !------------------------------------------------------------------------------! 6470 SUBROUTINE supersaturation_ice ( i, j, k ) 6471 6472 INTEGER(iwp) :: i !< running index 6473 INTEGER(iwp) :: j !< running index 6474 INTEGER(iwp) :: k !< running index 6475 6476 REAL(wp) :: e_a !< water vapor pressure 6477 REAL(wp) :: temp !< actual temperature 6478 ! 6479 !-- Actual liquid water temperature: 6480 t_l = exner(k) * pt(k,j,i) 6481 ! 6482 !-- Actual temperature: 6483 temp = t_l + lv_d_cp * ql(k,j,i) + ls_d_cp * qi(k,j,i) 6484 ! 6485 !-- Calculate water vapor saturation pressure with formular using actual 6486 !-- temperature 6487 e_si = magnus_ice( temp ) 6488 ! 6489 !-- Computation of ice saturation mixing ratio: 6490 q_si = rd_d_rv * e_si / ( hyp(k) - e_si ) 6491 ! 6492 !-- Current vapor pressure 6493 e_a = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) - qi(k,j,i) ) * hyp(k) / & 6494 ( ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) - qi(k,j,i) ) + rd_d_rv ) 5204 6495 ! 5205 6496 !-- Supersaturation: 5206 6497 !-- Not in case of microphysics_kessler or microphysics_sat_adjust 5207 6498 !-- since qr is unallocated 5208 IF ( microphysics_seifert ) THEN 5209 sat = ( q(k,j,i) - qr(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 5210 ELSEIF ( microphysics_morrison_no_rain ) THEN 5211 sat = ( q(k,j,i) - qc(k,j,i) ) / q_s - 1.0_wp 5212 ENDIF 5213 5214 END SUBROUTINE supersaturation 6499 sat_ice = e_a / e_si - 1.0_wp 6500 6501 END SUBROUTINE supersaturation_ice 5215 6502 5216 6503 … … 5224 6511 SUBROUTINE calc_liquid_water_content 5225 6512 5226 5227 5228 IMPLICIT NONE5229 5230 6513 INTEGER(iwp) :: i !< 5231 6514 INTEGER(iwp) :: j !< … … 5234 6517 REAL(wp) :: flag !< flag to indicate first grid level above surface 5235 6518 5236 5237 6519 DO i = nxlg, nxrg 5238 6520 DO j = nysg, nyng … … 5241 6523 !-- Predetermine flag to mask topography 5242 6524 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 0 ) ) 5243 5244 6525 ! 5245 6526 !-- Call calculation of supersaturation located 5246 6527 CALL supersaturation( i, j, k ) 5247 5248 6528 ! 5249 6529 !-- Compute the liquid water content 5250 IF ( microphysics_seifert .AND. .NOT. microphysics_morrison ) & 5251 THEN 5252 IF ( ( q(k,j,i) - q_s - qr(k,j,i) ) > 0.0_wp ) THEN 5253 qc(k,j,i) = ( q(k,j,i) - q_s - qr(k,j,i) ) * flag 5254 ql(k,j,i) = ( qc(k,j,i) + qr(k,j,i) ) * flag 6530 IF ( .NOT. microphysics_ice_extension ) THEN 6531 IF ( microphysics_seifert .AND. .NOT. & 6532 microphysics_morrison ) THEN 6533 !-- Seifert and Beheng scheme: saturation adjustment 6534 IF ( ( q(k,j,i) - q_s - qr(k,j,i) ) > 0.0_wp ) THEN 6535 qc(k,j,i) = ( q(k,j,i) - q_s - qr(k,j,i) ) * flag 6536 ql(k,j,i) = ( qc(k,j,i) + qr(k,j,i) ) * flag 6537 ELSE 6538 IF ( q(k,j,i) < qr(k,j,i) ) q(k,j,i) = qr(k,j,i) 6539 qc(k,j,i) = 0.0_wp 6540 ql(k,j,i) = qr(k,j,i) * flag 6541 ENDIF 6542 ! 6543 !-- Morrison scheme: explicit condensation (see above) 6544 ELSEIF ( microphysics_morrison .AND. & 6545 microphysics_seifert ) THEN 6546 ql(k,j,i) = qc(k,j,i) + qr(k,j,i) * flag 6547 !-- Morrison without rain: explicit condensation 6548 ELSEIF ( microphysics_morrison .AND. & 6549 .NOT. microphysics_seifert ) THEN 6550 ql(k,j,i) = qc(k,j,i) 6551 !-- Kessler and saturation adjustment scheme 5255 6552 ELSE 5256 IF ( q(k,j,i) < qr(k,j,i) ) q(k,j,i) = qr(k,j,i) 5257 qc(k,j,i) = 0.0_wp 5258 ql(k,j,i) = qr(k,j,i) * flag 6553 IF ( ( q(k,j,i) - q_s ) > 0.0_wp ) THEN 6554 qc(k,j,i) = ( q(k,j,i) - q_s ) * flag 6555 ql(k,j,i) = qc(k,j,i) * flag 6556 ELSE 6557 qc(k,j,i) = 0.0_wp 6558 ql(k,j,i) = 0.0_wp 6559 ENDIF 5259 6560 ENDIF 5260 ELSEIF ( microphysics_morrison .AND. microphysics_seifert ) THEN 5261 ql(k,j,i) = qc(k,j,i) + qr(k,j,i) * flag 5262 ELSEIF ( microphysics_morrison .AND. .NOT. microphysics_seifert ) THEN 5263 ql(k,j,i) = qc(k,j,i) 6561 !-- Calculations of liquid water content in case of mixed-phase 6562 !-- cloud microphyics 5264 6563 ELSE 5265 IF ( ( q(k,j,i) - q_s ) > 0.0_wp ) THEN 5266 qc(k,j,i) = ( q(k,j,i) - q_s ) * flag 5267 ql(k,j,i) = qc(k,j,i) * flag 6564 IF ( microphysics_seifert .AND. & 6565 .NOT. microphysics_morrison ) & 6566 THEN 6567 ! 6568 !-- Seifert and Beheng scheme: saturation adjustment 6569 IF ( ( q(k,j,i) & 6570 - q_s - qr(k,j,i) - qi(k,j,i) ) > 0.0_wp ) THEN 6571 qc(k,j,i) = ( q(k,j,i) - q_s - qr(k,j,i) - qi(k,j,i) )& 6572 * flag 6573 ql(k,j,i) = ( qc(k,j,i) + qr(k,j,i) ) * flag 6574 ELSE 6575 IF ( q(k,j,i) < ( qr(k,j,i) + qi(k,j,i) ) ) THEN 6576 q(k,j,i) = qr(k,j,i) + qi(k,j,i) 6577 ENDIF 6578 qc(k,j,i) = 0.0_wp 6579 ql(k,j,i) = qr(k,j,i) * flag 6580 ENDIF 6581 !-- Morrison scheme: explicit condensation (see above) 6582 ELSEIF ( microphysics_morrison .AND. & 6583 microphysics_seifert ) THEN 6584 ql(k,j,i) = qc(k,j,i) + qr(k,j,i) * flag 6585 !-- Morrison without rain: explicit condensation 6586 ELSEIF ( microphysics_morrison .AND. & 6587 .NOT. microphysics_seifert ) THEN 6588 ql(k,j,i) = qc(k,j,i) 6589 !-- Kessler and saturation adjustment scheme 5268 6590 ELSE 5269 qc(k,j,i) = 0.0_wp 5270 ql(k,j,i) = 0.0_wp 6591 IF ( ( q(k,j,i) - q_s ) > 0.0_wp ) THEN 6592 qc(k,j,i) = ( q(k,j,i) - q_s ) * flag 6593 ql(k,j,i) = qc(k,j,i) * flag 6594 ELSE 6595 qc(k,j,i) = 0.0_wp 6596 ql(k,j,i) = 0.0_wp 6597 ENDIF 5271 6598 ENDIF 5272 6599 ENDIF -
palm/trunk/SOURCE/compute_vpt.f90
r4360 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4360 2020-01-07 11:25:50Z suehring 27 30 ! Corrected "Former revisions" section 28 31 ! … … 42 45 43 46 USE arrays_3d, & 44 ONLY: pt, q, ql, vpt, d_exner 47 ONLY: pt, q, ql, vpt, d_exner, qi 45 48 46 49 USE basic_constants_and_equations_mod, & 47 ONLY: lv_d_cp 50 ONLY: lv_d_cp, ls_d_cp 48 51 49 52 USE control_parameters, & … … 56 59 57 60 USE bulk_cloud_model_mod, & 58 ONLY: bulk_cloud_model 61 ONLY: bulk_cloud_model, microphysics_ice_extension 59 62 60 63 IMPLICIT NONE … … 64 67 IF ( .NOT. bulk_cloud_model .AND. .NOT. cloud_droplets ) THEN 65 68 vpt = pt * ( 1.0_wp + 0.61_wp * q ) 66 ELSE IF (bulk_cloud_model) THEN69 ELSEIF ( bulk_cloud_model .AND. .NOT. microphysics_ice_extension ) THEN 67 70 DO k = nzb, nzt+1 68 vpt(k,:,:) = ( pt(k,:,:) + d_exner(k) * lv_d_cp * ql(k,:,:) ) * & 69 ( 1.0_wp + 0.61_wp * q(k,:,:) - 1.61_wp * ql(k,:,:) ) 71 vpt(k,:,:) = ( pt(k,:,:) + d_exner(k) * lv_d_cp * ql(k,:,:) ) * & 72 ( 1.0_wp + 0.61_wp * q(k,:,:) - 1.61_wp * ql(k,:,:) ) 73 ENDDO 74 ELSEIF ( bulk_cloud_model .AND. microphysics_ice_extension ) THEN 75 DO k = nzb, nzt+1 76 vpt(k,:,:) = ( pt(k,:,:) + d_exner(k) * lv_d_cp * ql(k,:,:) + & 77 d_exner(k) * ls_d_cp * qi(k,:,:) ) * & 78 ( 1.0_wp + 0.61_wp * q(k,:,:) - 1.61_wp * & 79 ( ql(k,:,:) + qi(k,:,:) ) ) 70 80 ENDDO 71 81 ELSE -
palm/trunk/SOURCE/flow_statistics.f90
r4472 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4472 2020-03-24 12:21:00Z Giersch 27 30 ! Calculations of the Kolmogorov lengt scale eta implemented 28 31 ! … … 84 87 USE arrays_3d, & 85 88 ONLY: ddzu, ddzw, e, heatflux_output_conversion, hyp, km, kh, & 86 momentumflux_output_conversion, nc, n r, p, prho, prr, pt, q,&87 qc, q l, qr, rho_air, rho_air_zw, rho_ocean, s,&89 momentumflux_output_conversion, nc, ni, nr, p, prho, prr, pt, q,& 90 qc, qi, ql, qr, rho_air, rho_air_zw, rho_ocean, s, & 88 91 sa, u, ug, v, vg, vpt, w, w_subs, waterflux_output_conversion, & 89 92 zw, d_exner … … 93 96 94 97 USE bulk_cloud_model_mod, & 95 ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert 98 ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert, & 99 microphysics_ice_extension 96 100 97 101 USE chem_modules, & … … 1414 1418 flag 1415 1419 ENDIF 1420 IF ( microphysics_ice_extension ) THEN 1421 sums_l(k,124,tn) = sums_l(k,124,tn) + ni(k,j,i) * & 1422 rmask(j,i,sr) *& 1423 flag 1424 sums_l(k,125,tn) = sums_l(k,125,tn) + qi(k,j,i) * & 1425 rmask(j,i,sr) *& 1426 flag 1427 ENDIF 1428 1416 1429 IF ( microphysics_seifert ) THEN 1417 1430 sums_l(k,73,tn) = sums_l(k,73,tn) + nr(k,j,i) * & … … 1915 1928 sums(k,116) = sums(k,116) / ngp_2dh_s_inner(k,sr) 1916 1929 sums(k,118:pr_palm-2) = sums(k,118:pr_palm-2) / ngp_2dh_s_inner(k,sr) 1917 sums(k,123 ) = sums(k,123) * ngp_2dh_s_inner(k,sr) / ngp_2dh(sr)1930 sums(k,123:125) = sums(k,123:125) * ngp_2dh_s_inner(k,sr) / ngp_2dh(sr) 1918 1931 ENDIF 1919 1932 ENDDO … … 2029 2042 hom(:,1,72,sr) = hyp * 1E-2_wp ! hyp in hPa 2030 2043 hom(:,1,123,sr) = sums(:,123) ! nc 2044 hom(:,1,124,sr) = sums(:,124) ! ni 2045 hom(:,1,125,sr) = sums(:,125) ! qi 2031 2046 hom(:,1,73,sr) = sums(:,73) ! nr 2032 2047 hom(:,1,74,sr) = sums(:,74) ! qr -
palm/trunk/SOURCE/init_masks.f90
r4444 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4444 2020-03-05 15:59:50Z raasch 27 30 ! bugfix: cpp-directives for serial mode added 28 31 ! … … 58 61 59 62 USE bulk_cloud_model_mod, & 60 ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert 63 ONLY: bulk_cloud_model, microphysics_morrison, microphysics_seifert, & 64 microphysics_ice_extension 61 65 62 66 USE control_parameters, & … … 268 272 unit = '1/m3' 269 273 274 CASE ( 'ni' ) 275 IF ( .NOT. bulk_cloud_model ) THEN 276 WRITE ( message_string, * ) 'output of "', TRIM( var ), & 277 '" requires bulk_cloud_model = .TRUE.' 278 CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 ) 279 ELSEIF ( .NOT. microphysics_ice_extension ) THEN 280 message_string = 'output of "' // TRIM( var ) // '" ' // & 281 'requires microphysics_ice_extension = .TRUE.' 282 CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 ) 283 ENDIF 284 unit = '1/m3' 285 270 286 CASE ( 'nr' ) 271 287 IF ( .NOT. bulk_cloud_model ) THEN … … 331 347 '" requires bulk_cloud_model = .TRUE.' 332 348 CALL message( 'init_masks', 'PA0108', 1, 2, 0, 6, 0 ) 349 ENDIF 350 unit = 'kg/kg' 351 352 CASE ( 'qi' ) 353 IF ( .NOT. bulk_cloud_model ) THEN 354 message_string = 'output of "' // TRIM( var ) // '" ' // & 355 'requires bulk_cloud_model = .TRUE.' 356 CALL message( 'check_parameters', 'PA0108', 1, 2, 0, 6, 0 ) 357 ELSEIF ( .NOT. microphysics_ice_extension ) THEN 358 message_string = 'output of "' // TRIM( var ) // '" ' // & 359 'requires microphysics_ice_extension = .TRUE.' 360 CALL message( 'check_parameters', 'PA0359', 1, 2, 0, 6, 0 ) 333 361 ENDIF 334 362 unit = 'kg/kg' -
palm/trunk/SOURCE/modules.f90
r4495 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4495 2020-04-13 20:11:20Z raasch 27 30 ! +restart_data_format, restart_data_format_input|output, include_total_domain_boundaries 28 31 ! … … 229 232 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_e !< artificial numerical dissipation flux at south face of grid box - subgrid-scale TKE 230 233 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_nc !< artificial numerical dissipation flux at south face of grid box - clouddrop-number concentration 234 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_ni !< artificial numerical dissipation flux at south face of grid box - ice crystal-number concentration 231 235 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_nr !< artificial numerical dissipation flux at south face of grid box - raindrop-number concentration 232 236 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_pt !< artificial numerical dissipation flux at south face of grid box - potential temperature 233 237 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_q !< artificial numerical dissipation flux at south face of grid box - mixing ratio 234 238 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_qc !< artificial numerical dissipation flux at south face of grid box - cloudwater 239 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_qi !< artificial numerical dissipation flux at south face of grid box - ice crystal mixing ratio 235 240 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_qr !< artificial numerical dissipation flux at south face of grid box - rainwater 236 241 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: diss_s_s !< artificial numerical dissipation flux at south face of grid box - passive scalar … … 244 249 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_e !< 6th-order advective flux at south face of grid box - subgrid-scale TKE 245 250 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_nc !< 6th-order advective flux at south face of grid box - clouddrop-number concentration 251 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_ni !< 6th-order advective flux at south face of grid box - icecrystal-number concentration 246 252 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_nr !< 6th-order advective flux at south face of grid box - raindrop-number concentration 247 253 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_pt !< 6th-order advective flux at south face of grid box - potential temperature 248 254 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_q !< 6th-order advective flux at south face of grid box - mixing ratio 249 255 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_qc !< 6th-order advective flux at south face of grid box - cloudwater 256 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_qi !< 6th-order advective flux at south face of grid box - ice crystal 250 257 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_qr !< 6th-order advective flux at south face of grid box - rainwater 251 258 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: flux_s_s !< 6th-order advective flux at south face of grid box - passive scalar … … 271 278 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_e !< artificial numerical dissipation flux at left face of grid box - subgrid-scale TKE 272 279 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_nc !< artificial numerical dissipation flux at left face of grid box - clouddrop-number concentration 280 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_ni !< artificial numerical dissipation flux at left face of grid box - ice crystal-number concentration 273 281 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_nr !< artificial numerical dissipation flux at left face of grid box - raindrop-number concentration 274 282 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_pt !< artificial numerical dissipation flux at left face of grid box - potential temperature 275 283 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_q !< artificial numerical dissipation flux at left face of grid box - mixing ratio 276 284 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_qc !< artificial numerical dissipation flux at left face of grid box - cloudwater 285 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_qi !< artificial numerical dissipation flux at left face of grid box - ice crystal 277 286 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_qr !< artificial numerical dissipation flux at left face of grid box - rainwater 278 287 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: diss_l_s !< artificial numerical dissipation flux at left face of grid box - passive scalar … … 284 293 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_e !< 6th-order advective flux at south face of grid box - subgrid-scale TKE 285 294 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_nc !< 6th-order advective flux at south face of grid box - clouddrop-number concentration 295 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_ni !< 6th-order advective flux at south face of grid box - ice crystal-number concentration 286 296 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_nr !< 6th-order advective flux at south face of grid box - raindrop-number concentration 287 297 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_pt !< 6th-order advective flux at south face of grid box - potential temperature 288 298 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_q !< 6th-order advective flux at south face of grid box - mixing ratio 289 299 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_qc !< 6th-order advective flux at south face of grid box - cloudwater 300 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_qi !< 6th-order advective flux at south face of grid box - ice crystal 290 301 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_qr !< 6th-order advective flux at south face of grid box - rainwater 291 302 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: flux_l_s !< 6th-order advective flux at south face of grid box - passive scalar … … 324 335 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nc_2 !< pointer for swapping of timelevels for respective quantity 325 336 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nc_3 !< pointer for swapping of timelevels for respective quantity 337 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ni_1 !< pointer for swapping of timelevels for respective quantity 338 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ni_2 !< pointer for swapping of timelevels for respective quantity 339 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ni_3 !< pointer for swapping of timelevels for respective quantity 326 340 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nr_1 !< pointer for swapping of timelevels for respective quantity 327 341 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nr_2 !< pointer for swapping of timelevels for respective quantity … … 336 350 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qc_2 !< pointer for swapping of timelevels for respective quantity 337 351 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qc_3 !< pointer for swapping of timelevels for respective quantity 352 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qi_1 !< pointer for swapping of timelevels for respective quantity 353 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qi_2 !< pointer for swapping of timelevels for respective quantity 354 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qi_3 !< pointer for swapping of timelevels for respective quantity 338 355 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ql_v !< pointer: volume of liquid water 339 356 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ql_vp !< pointer: liquid water weighting factor … … 367 384 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: nc !< pointer: cloud drop number density 368 385 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: nc_p !< pointer: prognostic value of cloud drop number density 386 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ni !< pointer: ice crystal number density 387 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ni_p !< pointer: prognostic value of ice crystal number density 369 388 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: nr !< pointer: rain drop number density 370 389 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: nr_p !< pointer: prognostic value of rain drop number density … … 375 394 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: q_p !< pointer: prognostic value of mixing ratio 376 395 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: qc !< pointer: cloud water content 377 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: qc_p !< pointer: cloud water content 396 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: qc_p !< pointer: prognostic value cloud water content 397 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: qi !< pointer: ice crystal content 398 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: qi_p !< pointer: prognostic value ice crystal content 378 399 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ql !< pointer: liquid water content 379 400 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ql_c !< pointer: change in liquid water content due to … … 389 410 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: te_m !< pointer: weighted tendency of e for previous sub-timestep (Runge-Kutta) 390 411 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tnc_m !< pointer: weighted tendency of nc for previous sub-timestep (Runge-Kutta) 412 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tni_m !< pointer: weighted tendency of ni for previous sub-timestep (Runge-Kutta) 391 413 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tnr_m !< pointer: weighted tendency of nr for previous sub-timestep (Runge-Kutta) 392 414 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tpt_m !< pointer: weighted tendency of pt for previous sub-timestep (Runge-Kutta) 393 415 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tq_m !< pointer: weighted tendency of q for previous sub-timestep (Runge-Kutta) 394 416 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tqc_m !< pointer: weighted tendency of qc for previous sub-timestep (Runge-Kutta) 417 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tqi_m !< pointer: weighted tendency of qi for previous sub-timestep (Runge-Kutta) 395 418 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: tqr_m !< pointer: weighted tendency of qr for previous sub-timestep (Runge-Kutta) 396 419 REAL(wp), DIMENSION(:,:,:), POINTER, CONTIGUOUS :: ts_m !< pointer: weighted tendency of s for previous sub-timestep (Runge-Kutta) … … 462 485 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: lpt_av !< avg. liquid water potential temperature 463 486 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nc_av !< avg. cloud drop number density 487 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ni_av !< avg. ice crystal number density 464 488 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nr_av !< avg. rain drop number density 465 489 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: p_av !< avg. perturbation pressure … … 471 495 !< (or total water content with active cloud physics) 472 496 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qc_av !< avg. cloud water content 497 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qi_av !< avg. ice crystal content 473 498 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ql_av !< avg. liquid water content 474 499 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ql_c_av !< avg. change in liquid water content due to … … 1423 1448 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_ws2_ws_l !< subdomain sum of vertical momentum flux w'w' (5th-order advection scheme only) 1424 1449 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wsncs_ws_l !< subdomain sum of vertical clouddrop-number concentration flux w'nc' (5th-order advection scheme only) 1450 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wsnis_ws_l !< subdomain sum of vertical ice crystal concentration flux w'ni' (5th-order advection scheme only) 1425 1451 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wsnrs_ws_l !< subdomain sum of vertical raindrop-number concentration flux w'nr' (5th-order advection scheme only) 1426 1452 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wspts_ws_l !< subdomain sum of vertical sensible heat flux w'pt' (5th-order advection scheme only) 1427 1453 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wsqs_ws_l !< subdomain sum of vertical latent heat flux w'q' (5th-order advection scheme only) 1428 1454 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wsqcs_ws_l !< subdomain sum of vertical cloudwater flux w'qc' (5th-order advection scheme only) 1455 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wsqis_ws_l !< subdomain sum of vertical ice crystal flux w'qi' (5th-order advection scheme only) 1429 1456 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wsqrs_ws_l !< subdomain sum of vertical rainwater flux w'qr' (5th-order advection scheme only) 1430 1457 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: sums_wssas_ws_l !< subdomain sum of vertical salinity flux w'sa' (5th-order advection scheme only) -
palm/trunk/SOURCE/netcdf_interface_mod.f90
r4455 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4455 2020-03-11 12:20:29Z Giersch 27 30 ! Axis attribute added to netcdf output 28 31 ! … … 880 883 CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr', & 881 884 'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv', & 882 's', 'theta', 'thetal', 'thetav' )885 's', 'theta', 'thetal', 'thetav', 'qi', 'ni' ) 883 886 884 887 grid_x = 'x' … … 1644 1647 CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr', & 1645 1648 'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv', & 1646 's', 'theta', 'thetal', 'thetav' )1649 's', 'theta', 'thetal', 'thetav', 'qi', 'ni' ) 1647 1650 1648 1651 grid_x = 'x' … … 2659 2662 ! 2660 2663 !-- Most variables are defined on the zu grid 2661 CASE ( 'e_xy', 'nc_xy', 'n r_xy', 'p_xy',&2664 CASE ( 'e_xy', 'nc_xy', 'ni_xy', 'nr_xy', 'p_xy', & 2662 2665 'pc_xy', 'pr_xy', 'prr_xy', 'q_xy', & 2663 'qc_xy', 'q l_xy', 'ql_c_xy', 'ql_v_xy',&2666 'qc_xy', 'qi_xy', 'ql_xy', 'ql_c_xy', 'ql_v_xy', & 2664 2667 'ql_vp_xy', 'qr_xy', 'qv_xy', & 2665 2668 's_xy', & … … 3583 3586 ! 3584 3587 !-- Most variables are defined on the zu grid 3585 CASE ( 'e_xz', 'nc_xz', 'n r_xz', 'p_xz', 'pc_xz',&3586 'pr_xz', 'prr_xz', 'q_xz', 'qc_xz', 3588 CASE ( 'e_xz', 'nc_xz', 'ni_xz', 'nr_xz', 'p_xz', 'pc_xz', & 3589 'pr_xz', 'prr_xz', 'q_xz', 'qc_xz', 'qi_xz', & 3587 3590 'ql_xz', 'ql_c_xz', 'ql_v_xz', 'ql_vp_xz', 'qr_xz', & 3588 3591 'qv_xz', 's_xz', & … … 4460 4463 ! 4461 4464 !-- Most variables are defined on the zu grid 4462 CASE ( 'e_yz', 'nc_yz', 'n r_yz', 'p_yz', 'pc_yz',&4463 'pr_yz','prr_yz', 'q_yz', 'qc_yz', 'q l_yz',&4465 CASE ( 'e_yz', 'nc_yz', 'ni_yz', 'nr_yz', 'p_yz', 'pc_yz', & 4466 'pr_yz','prr_yz', 'q_yz', 'qc_yz', 'qi_yz', 'ql_yz', & 4464 4467 'ql_c_yz', 'ql_v_yz', 'ql_vp_yz', 'qr_yz', 'qv_yz', & 4465 4468 's_yz', & … … 5853 5856 ! 5854 5857 !-- Most variables are defined on the zu levels 5855 CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr', &5858 CASE ( 'e', 'nc', 'nr', 'p', 'pc', 'pr', 'prr', 'ni', 'qi', & 5856 5859 'q', 'qc', 'ql', 'ql_c', 'ql_v', 'ql_vp', 'qr', 'qv', & 5857 5860 'rho_sea_water', 's', 'sa', & -
palm/trunk/SOURCE/surface_data_output_mod.f90
r4500 r4502 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4500 2020-04-17 10:12:45Z suehring 27 30 ! - Correct output of ground/wall heat flux at USM surfaces 28 31 ! - Add conversion factor to heat and momentum-flux output … … 1695 1698 ENDIF 1696 1699 1700 CASE ( 'qis' ) 1701 ! 1702 !-- Output of instantaneous data 1703 IF ( av == 0 ) THEN 1704 CALL surface_data_output_collect( surf_def_h(0)%qis, & 1705 surf_def_h(1)%qis, & 1706 surf_lsm_h%qis, & 1707 surf_usm_h%qis, & 1708 surf_def_v(0)%qis, & 1709 surf_lsm_v(0)%qis, & 1710 surf_usm_v(0)%qis, & 1711 surf_def_v(1)%qis, & 1712 surf_lsm_v(1)%qis, & 1713 surf_usm_v(1)%qis, & 1714 surf_def_v(2)%qis, & 1715 surf_lsm_v(2)%qis, & 1716 surf_usm_v(2)%qis, & 1717 surf_def_v(3)%qis, & 1718 surf_lsm_v(3)%qis, & 1719 surf_usm_v(3)%qis ) 1720 ELSE 1721 ! 1722 !-- Output of averaged data 1723 surfaces%var_out(:) = surfaces%var_av(:,n_out) / & 1724 REAL( average_count_surf, KIND=wp ) 1725 surfaces%var_av(:,n_out) = 0.0_wp 1726 1727 ENDIF 1728 1729 CASE ( 'nis' ) 1730 ! 1731 !-- Output of instantaneous data 1732 IF ( av == 0 ) THEN 1733 CALL surface_data_output_collect( surf_def_h(0)%nis, & 1734 surf_def_h(1)%nis, & 1735 surf_lsm_h%nis, & 1736 surf_usm_h%nis, & 1737 surf_def_v(0)%nis, & 1738 surf_lsm_v(0)%nis, & 1739 surf_usm_v(0)%nis, & 1740 surf_def_v(1)%nis, & 1741 surf_lsm_v(1)%nis, & 1742 surf_usm_v(1)%nis, & 1743 surf_def_v(2)%nis, & 1744 surf_lsm_v(2)%nis, & 1745 surf_usm_v(2)%nis, & 1746 surf_def_v(3)%nis, & 1747 surf_lsm_v(3)%nis, & 1748 surf_usm_v(3)%nis ) 1749 ELSE 1750 ! 1751 !-- Output of averaged data 1752 surfaces%var_out(:) = surfaces%var_av(:,n_out) / & 1753 REAL( average_count_surf, KIND=wp ) 1754 surfaces%var_av(:,n_out) = 0.0_wp 1755 1756 ENDIF 1757 1697 1758 CASE ( 'qrs' ) 1698 1759 ! … … 2153 2214 surf_lsm_v(3)%ncsws, & 2154 2215 surf_usm_v(3)%ncsws ) 2216 ELSE 2217 ! 2218 !-- Output of averaged data 2219 surfaces%var_out(:) = surfaces%var_av(:,n_out) / & 2220 REAL( average_count_surf, KIND=wp ) 2221 surfaces%var_av(:,n_out) = 0.0_wp 2222 2223 ENDIF 2224 2225 2226 CASE ( 'qisws' ) 2227 ! 2228 !-- Output of instantaneous data 2229 IF ( av == 0 ) THEN 2230 CALL surface_data_output_collect( surf_def_h(0)%qisws, & 2231 surf_def_h(1)%qisws, & 2232 surf_lsm_h%qisws, & 2233 surf_usm_h%qisws, & 2234 surf_def_v(0)%qisws, & 2235 surf_lsm_v(0)%qisws, & 2236 surf_usm_v(0)%qisws, & 2237 surf_def_v(1)%qisws, & 2238 surf_lsm_v(1)%qisws, & 2239 surf_usm_v(1)%qisws, & 2240 surf_def_v(2)%qisws, & 2241 surf_lsm_v(2)%qisws, & 2242 surf_usm_v(2)%qisws, & 2243 surf_def_v(3)%qisws, & 2244 surf_lsm_v(3)%qisws, & 2245 surf_usm_v(3)%qisws ) 2246 ELSE 2247 ! 2248 !-- Output of averaged data 2249 surfaces%var_out(:) = surfaces%var_av(:,n_out) / & 2250 REAL( average_count_surf, KIND=wp ) 2251 surfaces%var_av(:,n_out) = 0.0_wp 2252 2253 ENDIF 2254 2255 CASE ( 'nisws' ) 2256 ! 2257 !-- Output of instantaneous data 2258 IF ( av == 0 ) THEN 2259 CALL surface_data_output_collect( surf_def_h(0)%nisws, & 2260 surf_def_h(1)%nisws, & 2261 surf_lsm_h%nisws, & 2262 surf_usm_h%nisws, & 2263 surf_def_v(0)%nisws, & 2264 surf_lsm_v(0)%nisws, & 2265 surf_usm_v(0)%nisws, & 2266 surf_def_v(1)%nisws, & 2267 surf_lsm_v(1)%nisws, & 2268 surf_usm_v(1)%nisws, & 2269 surf_def_v(2)%nisws, & 2270 surf_lsm_v(2)%nisws, & 2271 surf_usm_v(2)%nisws, & 2272 surf_def_v(3)%nisws, & 2273 surf_lsm_v(3)%nisws, & 2274 surf_usm_v(3)%nisws ) 2155 2275 ELSE 2156 2276 ! … … 3120 3240 surf_usm_v(3)%ncs, n_out ) 3121 3241 3242 CASE ( 'qis' ) 3243 CALL surface_data_output_sum_up( surf_def_h(0)%qis, & 3244 surf_def_h(1)%qis, & 3245 surf_lsm_h%qis, & 3246 surf_usm_h%qis, & 3247 surf_def_v(0)%qis, & 3248 surf_lsm_v(0)%qis, & 3249 surf_usm_v(0)%qis, & 3250 surf_def_v(1)%qis, & 3251 surf_lsm_v(1)%qis, & 3252 surf_usm_v(1)%qis, & 3253 surf_def_v(2)%qis, & 3254 surf_lsm_v(2)%qis, & 3255 surf_usm_v(2)%qis, & 3256 surf_def_v(3)%qis, & 3257 surf_lsm_v(3)%qis, & 3258 surf_usm_v(3)%qrs, n_out ) 3259 3260 CASE ( 'nis' ) 3261 CALL surface_data_output_sum_up( surf_def_h(0)%nis, & 3262 surf_def_h(1)%nis, & 3263 surf_lsm_h%nis, & 3264 surf_usm_h%nis, & 3265 surf_def_v(0)%nis, & 3266 surf_lsm_v(0)%nis, & 3267 surf_usm_v(0)%nis, & 3268 surf_def_v(1)%nis, & 3269 surf_lsm_v(1)%nis, & 3270 surf_usm_v(1)%nis, & 3271 surf_def_v(2)%nis, & 3272 surf_lsm_v(2)%nis, & 3273 surf_usm_v(2)%nis, & 3274 surf_def_v(3)%nis, & 3275 surf_lsm_v(3)%nis, & 3276 surf_usm_v(3)%nis, n_out ) 3277 3122 3278 CASE ( 'qrs' ) 3123 3279 CALL surface_data_output_sum_up( surf_def_h(0)%qrs, & … … 3411 3567 surf_lsm_v(3)%ncsws, & 3412 3568 surf_usm_v(3)%ncsws, n_out ) 3569 3570 CASE ( 'qisws' ) 3571 CALL surface_data_output_sum_up( surf_def_h(0)%qisws, & 3572 surf_def_h(1)%qisws, & 3573 surf_lsm_h%qisws, & 3574 surf_usm_h%qisws, & 3575 surf_def_v(0)%qisws, & 3576 surf_lsm_v(0)%qisws, & 3577 surf_usm_v(0)%qisws, & 3578 surf_def_v(1)%qisws, & 3579 surf_lsm_v(1)%qisws, & 3580 surf_usm_v(1)%qisws, & 3581 surf_def_v(2)%qisws, & 3582 surf_lsm_v(2)%qisws, & 3583 surf_usm_v(2)%qisws, & 3584 surf_def_v(3)%qisws, & 3585 surf_lsm_v(3)%qisws, & 3586 surf_usm_v(3)%qisws, n_out ) 3587 3588 CASE ( 'nisws' ) 3589 CALL surface_data_output_sum_up( surf_def_h(0)%nisws, & 3590 surf_def_h(1)%nisws, & 3591 surf_lsm_h%nisws, & 3592 surf_usm_h%nisws, & 3593 surf_def_v(0)%nisws, & 3594 surf_lsm_v(0)%nisws, & 3595 surf_usm_v(0)%nisws, & 3596 surf_def_v(1)%nisws, & 3597 surf_lsm_v(1)%nisws, & 3598 surf_usm_v(1)%nisws, & 3599 surf_def_v(2)%nisws, & 3600 surf_lsm_v(2)%nisws, & 3601 surf_usm_v(2)%nisws, & 3602 surf_def_v(3)%nisws, & 3603 surf_lsm_v(3)%nisws, & 3604 surf_usm_v(3)%nisws, n_out ) 3413 3605 3414 3606 CASE ( 'qrsws' ) … … 4533 4725 unit = 'm/s' 4534 4726 4535 CASE ( 'ss', 'qcs', 'ncs', 'q rs', 'nrs' )4727 CASE ( 'ss', 'qcs', 'ncs', 'qis', 'nis', 'qrs', 'nrs' ) 4536 4728 unit = '1' 4537 4729 … … 4545 4737 unit = 'm2/s2' 4546 4738 4547 CASE ( 'qcsws', 'ncsws', 'q rsws', 'nrsws', 'sasws' )4739 CASE ( 'qcsws', 'ncsws', 'qisws', 'nisws', 'qrsws', 'nrsws', 'sasws' ) 4548 4740 4549 4741 CASE ( 'shf' ) -
palm/trunk/SOURCE/surface_mod.f90
r4495 r4502 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Implementation of ice microphysics 29 ! 30 ! 4495 2020-04-13 20:11:20Z raasch 28 31 ! restart data handling with MPI-IO added 29 32 ! … … 148 151 149 152 ! 150 !-- Data type used to identify grid-points where horizontal boundary conditions 151 !-- are applied 153 !-- Data type used to identify grid-points where horizontal boundary conditions 154 !-- are applied 152 155 TYPE bc_type 153 156 INTEGER(iwp) :: ioff !< offset value in x-direction, used to determine index of surface element … … 156 159 INTEGER(iwp) :: ns !< number of surface elements on the PE 157 160 158 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid 159 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid 160 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: k !< z-index linking to the PALM 3D-grid 161 162 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< start index within surface data type for given (j,i) 163 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< end index within surface data type for given (j,i) 161 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid 162 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid 163 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: k !< z-index linking to the PALM 3D-grid 164 165 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< start index within surface data type for given (j,i) 166 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< end index within surface data type for given (j,i) 164 167 165 168 END TYPE bc_type 166 169 ! 167 !-- Data type used to identify and treat surface-bounded grid points 170 !-- Data type used to identify and treat surface-bounded grid points 168 171 TYPE surf_type 169 172 170 173 LOGICAL :: albedo_from_ascii = .FALSE. !< flag indicating that albedo for urban surfaces is input via ASCII format (just for a workaround) 171 174 172 175 INTEGER(iwp) :: ioff !< offset value in x-direction, used to determine index of surface element 173 176 INTEGER(iwp) :: joff !< offset value in y-direction, used to determine index of surface element … … 175 178 INTEGER(iwp) :: ns !< number of surface elements on the PE 176 179 177 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid 178 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid 179 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: k !< z-index linking to the PALM 3D-grid 180 181 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: facing !< Bit indicating surface orientation 182 183 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< Start index within surface data type for given (j,i) 184 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< End index within surface data type for given (j,i) 185 186 REAL(wp), DIMENSION(:), ALLOCATABLE :: z_mo !< surface-layer height 180 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid 181 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid 182 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: k !< z-index linking to the PALM 3D-grid 183 184 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: facing !< Bit indicating surface orientation 185 186 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< Start index within surface data type for given (j,i) 187 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< End index within surface data type for given (j,i) 188 189 REAL(wp), DIMENSION(:), ALLOCATABLE :: z_mo !< surface-layer height 187 190 REAL(wp), DIMENSION(:), ALLOCATABLE :: uvw_abs !< absolute surface-parallel velocity 188 191 REAL(wp), DIMENSION(:), ALLOCATABLE :: us !< friction velocity … … 192 195 REAL(wp), DIMENSION(:), ALLOCATABLE :: qcs !< scaling parameter qc 193 196 REAL(wp), DIMENSION(:), ALLOCATABLE :: ncs !< scaling parameter nc 197 REAL(wp), DIMENSION(:), ALLOCATABLE :: qis !< scaling parameter qi 198 REAL(wp), DIMENSION(:), ALLOCATABLE :: nis !< scaling parameter ni 194 199 REAL(wp), DIMENSION(:), ALLOCATABLE :: qrs !< scaling parameter qr 195 200 REAL(wp), DIMENSION(:), ALLOCATABLE :: nrs !< scaling parameter nr … … 205 210 REAL(wp), DIMENSION(:), ALLOCATABLE :: qv1 !< mixing ratio at first grid level 206 211 REAL(wp), DIMENSION(:), ALLOCATABLE :: vpt1 !< virtual potential temperature at first grid level 207 212 208 213 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: css !< scaling parameter chemical species 209 214 ! 210 215 !-- Define arrays for surface fluxes 211 216 REAL(wp), DIMENSION(:), ALLOCATABLE :: usws !< vertical momentum flux for u-component at horizontal surfaces 212 REAL(wp), DIMENSION(:), ALLOCATABLE :: vsws !< vertical momentum flux for v-component at horizontal surfaces 217 REAL(wp), DIMENSION(:), ALLOCATABLE :: vsws !< vertical momentum flux for v-component at horizontal surfaces 213 218 214 219 REAL(wp), DIMENSION(:), ALLOCATABLE :: shf !< surface flux sensible heat 215 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws !< surface flux latent heat 220 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws !< surface flux latent heat 216 221 REAL(wp), DIMENSION(:), ALLOCATABLE :: ssws !< surface flux passive scalar 217 222 REAL(wp), DIMENSION(:), ALLOCATABLE :: qcsws !< surface flux qc 218 223 REAL(wp), DIMENSION(:), ALLOCATABLE :: ncsws !< surface flux nc 224 REAL(wp), DIMENSION(:), ALLOCATABLE :: qisws !< surface flux qi 225 REAL(wp), DIMENSION(:), ALLOCATABLE :: nisws !< surface flux ni 219 226 REAL(wp), DIMENSION(:), ALLOCATABLE :: qrsws !< surface flux qr 220 227 REAL(wp), DIMENSION(:), ALLOCATABLE :: nrsws !< surface flux nr … … 224 231 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: amsws !< surface flux aerosol mass: dim 1: flux, dim 2: bin 225 232 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gtsws !< surface flux gesous tracers: dim 1: flux, dim 2: gas 226 233 227 234 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: cssws !< surface flux chemical species 228 235 ! … … 240 247 CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: vegetation_type_name !< water type at name surface element 241 248 CHARACTER(LEN=40), DIMENSION(:), ALLOCATABLE :: water_type_name !< water type at name surface element 242 249 243 250 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: nzt_pavement !< top index for pavement in soil 244 251 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: building_type !< building type at surface element … … 246 253 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: vegetation_type !< vegetation type at surface element 247 254 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: water_type !< water type at surface element 248 255 249 256 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: albedo_type !< albedo type, for each fraction (wall,green,window or vegetation,pavement water) 250 257 … … 254 261 LOGICAL, DIMENSION(:), ALLOCATABLE :: water_surface !< flag parameter for water surfaces 255 262 LOGICAL, DIMENSION(:), ALLOCATABLE :: vegetation_surface !< flag parameter for natural land surfaces 256 263 257 264 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: albedo !< broadband albedo for each surface fraction (LSM: vegetation, water, pavement; USM: wall, green, window) 258 265 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: emissivity !< emissivity of the surface, for each fraction (LSM: vegetation, water, pavement; USM: wall, green, window) … … 271 278 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_surface !< skin-surface temperature 272 279 REAL(wp), DIMENSION(:), ALLOCATABLE :: vpt_surface !< skin-surface virtual temperature 273 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net !< net radiation 280 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net !< net radiation 274 281 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net_l !< net radiation, used in USM 275 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h !< heat conductivity of soil/ wall (W/m/K) 276 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_green !< heat conductivity of green soil (W/m/K) 277 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_window !< heat conductivity of windows (W/m/K) 278 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_def !< default heat conductivity of soil (W/m/K) 282 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h !< heat conductivity of soil/ wall (W/m/K) 283 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_green !< heat conductivity of green soil (W/m/K) 284 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_window !< heat conductivity of windows (W/m/K) 285 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_def !< default heat conductivity of soil (W/m/K) 279 286 280 287 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_in !< incoming longwave radiation … … 302 309 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg !< surface flux of latent heat (vegetation portion) 303 310 304 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a !< aerodynamic resistance 311 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a !< aerodynamic resistance 305 312 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a_green !< aerodynamic resistance at green fraction 306 313 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a_window !< aerodynamic resistance at window fraction … … 310 317 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_s !< total surface resistance (combination of r_soil and r_canopy) 311 318 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_canopy_min !< minimum canopy (stomatal) resistance 312 319 313 320 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_10cm !< near surface air potential temperature at distance 10 cm from the surface (K) 314 321 315 322 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: alpha_vg !< coef. of Van Genuchten 316 323 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_w !< hydraulic diffusivity of soil (?) … … 322 329 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_sat !< saturation soil moisture (m3/m3) 323 330 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_wilt !< soil moisture at permanent wilting point (m3/m3) 324 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: n_vg !< coef. Van Genuchten 331 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: n_vg !< coef. Van Genuchten 325 332 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_total_def !< default volumetric heat capacity of the (soil) layer (J/m3/K) 326 333 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_total !< volumetric heat capacity of the actual soil matrix (J/m3/K) 327 334 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: root_fr !< root fraction within the soil layers 328 335 329 336 !-- Indoor model variables 330 REAL(wp), DIMENSION(:), ALLOCATABLE :: waste_heat !< waste heat 337 REAL(wp), DIMENSION(:), ALLOCATABLE :: waste_heat !< waste heat 331 338 ! 332 339 !-- Urban surface variables … … 334 341 335 342 LOGICAL, DIMENSION(:), ALLOCATABLE :: isroof_surf !< flag indicating roof surfaces 336 LOGICAL, DIMENSION(:), ALLOCATABLE :: ground_level !< flag indicating ground floor level surfaces 343 LOGICAL, DIMENSION(:), ALLOCATABLE :: ground_level !< flag indicating ground floor level surfaces 337 344 338 345 REAL(wp), DIMENSION(:), ALLOCATABLE :: target_temp_summer !< indoor target temperature summer 339 REAL(wp), DIMENSION(:), ALLOCATABLE :: target_temp_winter !< indoor target temperature summer 346 REAL(wp), DIMENSION(:), ALLOCATABLE :: target_temp_winter !< indoor target temperature summer 340 347 341 348 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_surface !< heat capacity of the wall surface skin (J/m2/K) … … 373 380 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlw !< longwave radiation falling to local surface including radiation from reflections 374 381 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutlw !< total longwave radiation outgoing from nonvirtual surfaces surfaces after all reflection 375 382 376 383 REAL(wp), DIMENSION(:), ALLOCATABLE :: n_vg_green !< vangenuchten parameters 377 384 REAL(wp), DIMENSION(:), ALLOCATABLE :: alpha_vg_green !< vangenuchten parameters … … 384 391 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_wall_stag !< wall grid spacing (edge-edge) 385 392 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_wall_stag !< 1/dz_wall_stag 386 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_wall_m !< t_wall prognostic array 393 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_wall_m !< t_wall prognostic array 387 394 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw !< wall layer depths (m) 388 395 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_window !< volumetric heat capacity of the window material ( J m-3 K-1 ) (= 2.19E6) … … 391 398 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_window_stag !< window grid spacing (edge-edge) 392 399 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_window_stag !< 1/dz_window_stag 393 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_window_m !< t_window prognostic array 400 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_window_m !< t_window prognostic array 394 401 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw_window !< window layer depths (m) 395 402 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_green !< volumetric heat capacity of the green material ( J m-3 K-1 ) (= 2.19E6) … … 399 406 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_green_stag !< green grid spacing (edge-edge) 400 407 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_green_stag !< 1/dz_green_stag 401 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_green_m !< t_green prognostic array 408 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_green_m !< t_green prognostic array 402 409 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw_green !< green layer depths (m) 403 410 … … 421 428 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfins_av !< average of array of residua of sw radiation absorbed in surface after last reflection 422 429 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinl_av !< average of array of residua of lw radiation absorbed in surface after last reflection 423 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf_av !< average of total radiation flux incoming to minus outgoing from local surface 430 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf_av !< average of total radiation flux incoming to minus outgoing from local surface 424 431 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_av !< average of wghf_eb 425 432 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_window_av !< average of wghf_eb window … … 437 444 438 445 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_10cm_av !< average of theta_10cm (K) 439 446 440 447 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_wall_av !< Average of t_wall 441 448 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_window_av !< Average of t_window … … 455 462 TYPE (surf_type), DIMENSION(0:3), TARGET :: surf_usm_v !< vertical urban surfaces (North, South, East, West) 456 463 457 INTEGER(iwp), PARAMETER :: ind_veg_wall = 0 !< index for vegetation / wall-surface fraction, used for access of albedo, emissivity, etc., for each surface type 464 INTEGER(iwp), PARAMETER :: ind_veg_wall = 0 !< index for vegetation / wall-surface fraction, used for access of albedo, emissivity, etc., for each surface type 458 465 INTEGER(iwp), PARAMETER :: ind_pav_green = 1 !< index for pavement / green-wall surface fraction, used for access of albedo, emissivity, etc., for each surface type 459 466 INTEGER(iwp), PARAMETER :: ind_wat_win = 2 !< index for water / window-surface fraction, used for access of albedo, emissivity, etc., for each surface type 460 467 461 INTEGER(iwp) :: ns_h_on_file(0:2) !< total number of horizontal surfaces with the same facing, required for writing restart data 462 INTEGER(iwp) :: ns_v_on_file(0:3) !< total number of vertical surfaces with the same facing, required for writing restart data 463 464 LOGICAL :: vertical_surfaces_exist = .FALSE. !< flag indicating that there are vertical urban/land surfaces 468 INTEGER(iwp) :: ns_h_on_file(0:2) !< total number of horizontal surfaces with the same facing, required for writing restart data 469 INTEGER(iwp) :: ns_v_on_file(0:3) !< total number of vertical surfaces with the same facing, required for writing restart data 470 471 LOGICAL :: vertical_surfaces_exist = .FALSE. !< flag indicating that there are vertical urban/land surfaces 465 472 !< in the domain (required to activiate RTM) 466 473 … … 468 475 LOGICAL :: surf_microphysics_morrison = .FALSE. !< use 2-moment Morrison (add. prog. eq. for nc and qc) 469 476 LOGICAL :: surf_microphysics_seifert = .FALSE. !< use 2-moment Seifert and Beheng scheme 477 LOGICAL :: surf_microphysics_ice_extension = .FALSE. !< use 2-moment Seifert and Beheng scheme 470 478 471 479 … … 473 481 474 482 PRIVATE 475 483 476 484 INTERFACE init_bc 477 485 MODULE PROCEDURE init_bc … … 481 489 MODULE PROCEDURE init_single_surface_properties 482 490 END INTERFACE init_single_surface_properties 483 491 484 492 INTERFACE init_surfaces 485 493 MODULE PROCEDURE init_surfaces … … 522 530 surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v, surf_type, & 523 531 vertical_surfaces_exist, surf_bulk_cloud_model, surf_microphysics_morrison, & 524 surf_microphysics_seifert 532 surf_microphysics_seifert, surf_microphysics_ice_extension 525 533 ! 526 534 !-- Public subroutines and functions … … 544 552 ! Description: 545 553 ! ------------ 546 !> Initialize data type for setting boundary conditions at horizontal and 547 !> vertical surfaces. 554 !> Initialize data type for setting boundary conditions at horizontal and 555 !> vertical surfaces. 548 556 !------------------------------------------------------------------------------! 549 557 SUBROUTINE init_bc … … 559 567 INTEGER(iwp), DIMENSION(0:1) :: num_h_kji !< number of horizontal surfaces at (j,i)-grid point 560 568 INTEGER(iwp), DIMENSION(0:1) :: start_index_h !< local start index of horizontal surface elements 561 569 562 570 INTEGER(iwp), DIMENSION(0:3) :: num_v !< number of vertical surfaces on subdomain 563 571 INTEGER(iwp), DIMENSION(0:3) :: num_v_kji !< number of vertical surfaces at (j,i)-grid point 564 572 INTEGER(iwp), DIMENSION(0:3) :: start_index_v !< local start index of vertical surface elements 565 573 ! 566 !-- Set offset indices, i.e. index difference between surface element and 574 !-- Set offset indices, i.e. index difference between surface element and 567 575 !-- surface-bounded grid point. 568 576 !-- Horizontal surfaces - no horizontal offsets … … 596 604 ! 597 605 !-- Initialize data structure for horizontal surfaces, i.e. count the number 598 !-- of surface elements, allocate and initialize the respective index arrays, 599 !-- and set the respective start and end indices at each (j,i)-location. 600 !-- The index space is defined also over the ghost points, so that e.g. 601 !-- boundary conditions for diagnostic quanitities can be set on ghost 602 !-- points so that no exchange is required any more. 606 !-- of surface elements, allocate and initialize the respective index arrays, 607 !-- and set the respective start and end indices at each (j,i)-location. 608 !-- The index space is defined also over the ghost points, so that e.g. 609 !-- boundary conditions for diagnostic quanitities can be set on ghost 610 !-- points so that no exchange is required any more. 603 611 DO l = 0, 1 604 612 ! … … 608 616 DO j = nysg, nyng 609 617 DO k = nzb+1, nzt 610 ! 618 ! 611 619 !-- Check if current gridpoint belongs to the atmosphere 612 620 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN … … 619 627 ENDDO 620 628 ENDDO 621 ! 629 ! 622 630 !-- Save the number of horizontal surface elements 623 631 bc_h(l)%ns = num_h(l) … … 631 639 bc_h(l)%start_index = 1 632 640 bc_h(l)%end_index = 0 633 641 634 642 num_h(l) = 1 635 643 start_index_h(l) = 1 636 644 DO i = nxlg, nxrg 637 645 DO j = nysg, nyng 638 646 639 647 num_h_kji(l) = 0 640 648 DO k = nzb+1, nzt 641 ! 649 ! 642 650 !-- Check if current gridpoint belongs to the atmosphere 643 651 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 644 ! 652 ! 645 653 !-- Upward-facing 646 654 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_h(l)%koff, & … … 666 674 ! 667 675 !-- Initialize data structure for vertical surfaces, i.e. count the number 668 !-- of surface elements, allocate and initialize the respective index arrays, 676 !-- of surface elements, allocate and initialize the respective index arrays, 669 677 !-- and set the respective start and end indices at each (j,i)-location. 670 678 DO l = 0, 3 … … 675 683 DO j = nys, nyn 676 684 DO k = nzb+1, nzt 677 ! 685 ! 678 686 !-- Check if current gridpoint belongs to the atmosphere 679 687 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN … … 686 694 ENDDO 687 695 ENDDO 688 ! 696 ! 689 697 !-- Save the number of horizontal surface elements 690 698 bc_v(l)%ns = num_v(l) 691 699 ! 692 700 !-- ALLOCATE arrays for horizontal surfaces. In contrast to the 693 !-- horizontal surfaces, the index space is not defined over the 694 !-- ghost points. 701 !-- horizontal surfaces, the index space is not defined over the 702 !-- ghost points. 695 703 ALLOCATE( bc_v(l)%i(1:bc_v(l)%ns) ) 696 704 ALLOCATE( bc_v(l)%j(1:bc_v(l)%ns) ) … … 700 708 bc_v(l)%start_index = 1 701 709 bc_v(l)%end_index = 0 702 710 703 711 num_v(l) = 1 704 712 start_index_v(l) = 1 705 713 DO i = nxl, nxr 706 714 DO j = nys, nyn 707 715 708 716 num_v_kji(l) = 0 709 717 DO k = nzb+1, nzt 710 ! 718 ! 711 719 !-- Check if current gridpoint belongs to the atmosphere 712 720 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 713 ! 721 ! 714 722 !-- Upward-facing 715 723 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_v(l)%koff, & … … 741 749 ! ------------ 742 750 !> Initialize horizontal and vertical surfaces. Counts the number of default-, 743 !> natural and urban surfaces and allocates memory, respectively. 751 !> natural and urban surfaces and allocates memory, respectively. 744 752 !------------------------------------------------------------------------------! 745 753 SUBROUTINE init_surface_arrays … … 751 759 IMPLICIT NONE 752 760 753 INTEGER(iwp) :: i !< running index x-direction 761 INTEGER(iwp) :: i !< running index x-direction 754 762 INTEGER(iwp) :: j !< running index y-direction 755 763 INTEGER(iwp) :: k !< running index z-direction 756 764 INTEGER(iwp) :: l !< index variable for surface facing 757 INTEGER(iwp) :: num_lsm_h !< number of horizontally-aligned natural surfaces 758 INTEGER(iwp) :: num_usm_h !< number of horizontally-aligned urban surfaces 759 760 INTEGER(iwp), DIMENSION(0:2) :: num_def_h !< number of horizontally-aligned default surfaces 761 INTEGER(iwp), DIMENSION(0:3) :: num_def_v !< number of vertically-aligned default surfaces 762 INTEGER(iwp), DIMENSION(0:3) :: num_lsm_v !< number of vertically-aligned natural surfaces 763 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v !< number of vertically-aligned urban surfaces 765 INTEGER(iwp) :: num_lsm_h !< number of horizontally-aligned natural surfaces 766 INTEGER(iwp) :: num_usm_h !< number of horizontally-aligned urban surfaces 767 768 INTEGER(iwp), DIMENSION(0:2) :: num_def_h !< number of horizontally-aligned default surfaces 769 INTEGER(iwp), DIMENSION(0:3) :: num_def_v !< number of vertically-aligned default surfaces 770 INTEGER(iwp), DIMENSION(0:3) :: num_lsm_v !< number of vertically-aligned natural surfaces 771 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v !< number of vertically-aligned urban surfaces 764 772 765 773 INTEGER(iwp) :: num_surf_v_l !< number of vertically-aligned local urban/land surfaces … … 768 776 LOGICAL :: building !< flag indicating building grid point 769 777 LOGICAL :: terrain !< flag indicating natural terrain grid point 770 LOGICAL :: unresolved_building !< flag indicating a grid point where actually a building is 771 !< defined but not resolved by the vertical grid 778 LOGICAL :: unresolved_building !< flag indicating a grid point where actually a building is 779 !< defined but not resolved by the vertical grid 772 780 773 781 num_def_h = 0 … … 780 788 !-- Surfaces are classified according to the input data read from static 781 789 !-- input file. If no input file is present, all surfaces are classified 782 !-- either as natural, urban, or default, depending on the setting of 790 !-- either as natural, urban, or default, depending on the setting of 783 791 !-- land_surface and urban_surface. To control this, use the control 784 792 !-- flag topo_no_distinct 785 793 ! 786 !-- Count number of horizontal surfaces on local domain 794 !-- Count number of horizontal surfaces on local domain 787 795 DO i = nxl, nxr 788 796 DO j = nys, nyn … … 798 806 ! 799 807 !-- Determine flags indicating a terrain surface, a building 800 !-- surface, 808 !-- surface, 801 809 terrain = BTEST( wall_flags_total_0(k-1,j,i), 5 ) .OR. & 802 810 topo_no_distinct … … 804 812 topo_no_distinct 805 813 ! 806 !-- unresolved_building indicates a surface with equal height 814 !-- unresolved_building indicates a surface with equal height 807 815 !-- as terrain but with a non-grid resolved building on top. 808 816 !-- These surfaces will be flagged as urban surfaces. … … 813 821 IF ( land_surface .AND. terrain .AND. & 814 822 .NOT. unresolved_building ) THEN 815 num_lsm_h = num_lsm_h + 1 823 num_lsm_h = num_lsm_h + 1 816 824 ! 817 825 !-- Urban surface tpye 818 826 ELSEIF ( urban_surface .AND. building ) THEN 819 num_usm_h = num_usm_h + 1 827 num_usm_h = num_usm_h + 1 820 828 ! 821 829 !-- Default-surface type 822 830 ELSEIF ( .NOT. land_surface .AND. & 823 831 .NOT. urban_surface ) THEN 824 832 825 833 num_def_h(0) = num_def_h(0) + 1 826 834 ! 827 835 !-- Unclassifified surface-grid point. Give error message. 828 ELSE 836 ELSE 829 837 WRITE( message_string, * ) & 830 838 'Unclassified upward-facing ' // & … … 840 848 num_def_h(2) = num_def_h(2) + 1 841 849 ! 842 !-- Check for any other downward-facing surface. So far only for 850 !-- Check for any other downward-facing surface. So far only for 843 851 !-- default surface type. 844 852 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i), 0 ) ) THEN 845 853 num_def_h(1) = num_def_h(1) + 1 846 ENDIF 854 ENDIF 847 855 848 856 ENDIF … … 851 859 ENDDO 852 860 ! 853 !-- Count number of vertical surfaces on local domain 861 !-- Count number of vertical surfaces on local domain 854 862 DO i = nxl, nxr 855 863 DO j = nys, nyn … … 869 877 unresolved_building = BTEST( wall_flags_total_0(k,j-1,i), 5 ) & 870 878 .AND. BTEST( wall_flags_total_0(k,j-1,i), 6 ) 871 879 872 880 IF ( land_surface .AND. terrain .AND. & 873 881 .NOT. unresolved_building ) THEN 874 num_lsm_v(0) = num_lsm_v(0) + 1 882 num_lsm_v(0) = num_lsm_v(0) + 1 875 883 ELSEIF ( urban_surface .AND. building ) THEN 876 num_usm_v(0) = num_usm_v(0) + 1 884 num_usm_v(0) = num_usm_v(0) + 1 877 885 ! 878 886 !-- Default-surface type 879 887 ELSEIF ( .NOT. land_surface .AND. & 880 888 .NOT. urban_surface ) THEN 881 num_def_v(0) = num_def_v(0) + 1 889 num_def_v(0) = num_def_v(0) + 1 882 890 ! 883 891 !-- Unclassifified surface-grid point. Give error message. 884 ELSE 892 ELSE 885 893 WRITE( message_string, * ) & 886 894 'Unclassified northward-facing ' // & … … 900 908 building = BTEST( wall_flags_total_0(k,j+1,i), 6 ) .OR. & 901 909 topo_no_distinct 902 910 903 911 unresolved_building = BTEST( wall_flags_total_0(k,j+1,i), 5 ) & 904 .AND. BTEST( wall_flags_total_0(k,j+1,i), 6 ) 905 912 .AND. BTEST( wall_flags_total_0(k,j+1,i), 6 ) 913 906 914 IF ( land_surface .AND. terrain .AND. & 907 915 .NOT. unresolved_building ) THEN 908 num_lsm_v(1) = num_lsm_v(1) + 1 916 num_lsm_v(1) = num_lsm_v(1) + 1 909 917 ELSEIF ( urban_surface .AND. building ) THEN 910 num_usm_v(1) = num_usm_v(1) + 1 918 num_usm_v(1) = num_usm_v(1) + 1 911 919 ! 912 920 !-- Default-surface type 913 921 ELSEIF ( .NOT. land_surface .AND. & 914 922 .NOT. urban_surface ) THEN 915 num_def_v(1) = num_def_v(1) + 1 923 num_def_v(1) = num_def_v(1) + 1 916 924 ! 917 925 !-- Unclassifified surface-grid point. Give error message. 918 ELSE 926 ELSE 919 927 WRITE( message_string, * ) & 920 928 'Unclassified southward-facing ' // & … … 934 942 building = BTEST( wall_flags_total_0(k,j,i-1), 6 ) .OR. & 935 943 topo_no_distinct 936 944 937 945 unresolved_building = BTEST( wall_flags_total_0(k,j,i-1), 5 ) & 938 946 .AND. BTEST( wall_flags_total_0(k,j,i-1), 6 ) 939 947 940 948 IF ( land_surface .AND. terrain .AND. & 941 949 .NOT. unresolved_building ) THEN 942 num_lsm_v(2) = num_lsm_v(2) + 1 950 num_lsm_v(2) = num_lsm_v(2) + 1 943 951 ELSEIF ( urban_surface .AND. building ) THEN 944 num_usm_v(2) = num_usm_v(2) + 1 952 num_usm_v(2) = num_usm_v(2) + 1 945 953 ! 946 954 !-- Default-surface type 947 955 ELSEIF ( .NOT. land_surface .AND. & 948 956 .NOT. urban_surface ) THEN 949 num_def_v(2) = num_def_v(2) + 1 957 num_def_v(2) = num_def_v(2) + 1 950 958 ! 951 959 !-- Unclassifified surface-grid point. Give error message. 952 ELSE 960 ELSE 953 961 WRITE( message_string, * ) & 954 962 'Unclassified eastward-facing ' // & … … 968 976 building = BTEST( wall_flags_total_0(k,j,i+1), 6 ) .OR. & 969 977 topo_no_distinct 970 978 971 979 unresolved_building = BTEST( wall_flags_total_0(k,j,i+1), 5 ) & 972 980 .AND. BTEST( wall_flags_total_0(k,j,i+1), 6 ) 973 981 974 982 IF ( land_surface .AND. terrain .AND. & 975 983 .NOT. unresolved_building ) THEN 976 num_lsm_v(3) = num_lsm_v(3) + 1 984 num_lsm_v(3) = num_lsm_v(3) + 1 977 985 ELSEIF ( urban_surface .AND. building ) THEN 978 num_usm_v(3) = num_usm_v(3) + 1 986 num_usm_v(3) = num_usm_v(3) + 1 979 987 ! 980 988 !-- Default-surface type 981 989 ELSEIF ( .NOT. land_surface .AND. & 982 990 .NOT. urban_surface ) THEN 983 num_def_v(3) = num_def_v(3) + 1 991 num_def_v(3) = num_def_v(3) + 1 984 992 ! 985 993 !-- Unclassifified surface-grid point. Give error message. 986 ELSE 994 ELSE 987 995 WRITE( message_string, * ) & 988 996 'Unclassified westward-facing ' // & … … 1010 1018 ! 1011 1019 !-- Horizontal surface, natural type, so far only upward-facing 1012 surf_lsm_h%ns = num_lsm_h 1020 surf_lsm_h%ns = num_lsm_h 1013 1021 ! 1014 1022 !-- Horizontal surface, urban type, so far only upward-facing 1015 surf_usm_h%ns = num_usm_h 1023 surf_usm_h%ns = num_usm_h 1016 1024 ! 1017 1025 !-- Vertical surface, default type, northward facing … … 1051 1059 surf_usm_v(3)%ns = num_usm_v(3) 1052 1060 ! 1053 !-- Allocate required attributes for horizontal surfaces - default type. 1061 !-- Allocate required attributes for horizontal surfaces - default type. 1054 1062 !-- Upward-facing (l=0) and downward-facing (l=1). 1055 1063 DO l = 0, 1 … … 1060 1068 CALL allocate_surface_attributes_h_top ( surf_def_h(2), nys, nyn, nxl, nxr ) 1061 1069 ! 1062 !-- Allocate required attributes for horizontal surfaces - natural type. 1070 !-- Allocate required attributes for horizontal surfaces - natural type. 1063 1071 CALL allocate_surface_attributes_h ( surf_lsm_h, nys, nyn, nxl, nxr ) 1064 1072 ! 1065 !-- Allocate required attributes for horizontal surfaces - urban type. 1073 !-- Allocate required attributes for horizontal surfaces - urban type. 1066 1074 CALL allocate_surface_attributes_h ( surf_usm_h, nys, nyn, nxl, nxr ) 1067 1075 1068 1076 ! 1069 !-- Allocate required attributes for vertical surfaces. 1077 !-- Allocate required attributes for vertical surfaces. 1070 1078 !-- Northward-facing (l=0), southward-facing (l=1), eastward-facing (l=2) 1071 1079 !-- and westward-facing (l=3). … … 1101 1109 #endif 1102 1110 IF ( num_surf_v > 0 ) vertical_surfaces_exist = .TRUE. 1103 1111 1104 1112 1105 1113 END SUBROUTINE init_surface_arrays … … 1117 1125 1118 1126 INTEGER(iwp) :: l !< 1119 1127 1120 1128 !$ACC ENTER DATA & 1121 1129 !$ACC COPYIN(surf_def_h(0:2)) & … … 1162 1170 1163 1171 INTEGER(iwp) :: l !< 1164 1172 1165 1173 ! Delete data in surf_def_h(0:2) 1166 1174 DO l = 0, 1 … … 1199 1207 ! Description: 1200 1208 ! ------------ 1201 !> Deallocating memory for upward and downward-facing horizontal surface types, 1202 !> except for top fluxes. 1209 !> Deallocating memory for upward and downward-facing horizontal surface types, 1210 !> except for top fluxes. 1203 1211 !------------------------------------------------------------------------------! 1204 1212 SUBROUTINE deallocate_surface_attributes_h( surfaces ) … … 1242 1250 ! 1243 1251 !-- Vertical momentum fluxes of u and v 1244 DEALLOCATE ( surfaces%usws ) 1245 DEALLOCATE ( surfaces%vsws ) 1252 DEALLOCATE ( surfaces%usws ) 1253 DEALLOCATE ( surfaces%vsws ) 1246 1254 ! 1247 1255 !-- Required in production_e 1248 IF ( .NOT. constant_diffusion ) THEN 1249 DEALLOCATE ( surfaces%u_0 ) 1256 IF ( .NOT. constant_diffusion ) THEN 1257 DEALLOCATE ( surfaces%u_0 ) 1250 1258 DEALLOCATE ( surfaces%v_0 ) 1251 ENDIF 1259 ENDIF 1252 1260 ! 1253 1261 !-- Characteristic temperature and surface flux of sensible heat 1254 DEALLOCATE ( surfaces%ts ) 1262 DEALLOCATE ( surfaces%ts ) 1255 1263 DEALLOCATE ( surfaces%shf ) 1256 1264 ! 1257 1265 !-- surface temperature 1258 DEALLOCATE ( surfaces%pt_surface ) 1266 DEALLOCATE ( surfaces%pt_surface ) 1259 1267 ! 1260 1268 !-- Characteristic humidity and surface flux of latent heat 1261 IF ( humidity ) THEN 1262 DEALLOCATE ( surfaces%qs ) 1263 DEALLOCATE ( surfaces%qsws ) 1269 IF ( humidity ) THEN 1270 DEALLOCATE ( surfaces%qs ) 1271 DEALLOCATE ( surfaces%qsws ) 1264 1272 DEALLOCATE ( surfaces%q_surface ) 1265 1273 DEALLOCATE ( surfaces%vpt_surface ) 1266 ENDIF 1274 ENDIF 1267 1275 ! 1268 1276 !-- Characteristic scalar and surface flux of scalar 1269 1277 IF ( passive_scalar ) THEN 1270 DEALLOCATE ( surfaces%ss ) 1271 DEALLOCATE ( surfaces%ssws ) 1272 ENDIF 1278 DEALLOCATE ( surfaces%ss ) 1279 DEALLOCATE ( surfaces%ssws ) 1280 ENDIF 1273 1281 ! 1274 1282 !-- Scaling parameter (cs*) and surface flux of chemical species 1275 1283 IF ( air_chemistry ) THEN 1276 DEALLOCATE ( surfaces%css ) 1277 DEALLOCATE ( surfaces%cssws ) 1278 ENDIF 1284 DEALLOCATE ( surfaces%css ) 1285 DEALLOCATE ( surfaces%cssws ) 1286 ENDIF 1279 1287 ! 1280 1288 !-- Arrays for storing potential temperature and … … 1283 1291 DEALLOCATE ( surfaces%qv1 ) 1284 1292 DEALLOCATE ( surfaces%vpt1 ) 1285 1286 ! 1287 !-- 1293 1294 ! 1295 !-- 1288 1296 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1289 1297 DEALLOCATE ( surfaces%qcs ) … … 1293 1301 ENDIF 1294 1302 ! 1295 !-- 1303 !-- 1296 1304 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1297 1305 DEALLOCATE ( surfaces%qrs ) … … 1301 1309 ENDIF 1302 1310 ! 1311 !-- 1312 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension) THEN 1313 DEALLOCATE ( surfaces%qis ) 1314 DEALLOCATE ( surfaces%nis ) 1315 DEALLOCATE ( surfaces%qisws ) 1316 DEALLOCATE ( surfaces%nisws ) 1317 ENDIF 1318 ! 1303 1319 !-- Salinity surface flux 1304 1320 IF ( ocean_mode ) DEALLOCATE ( surfaces%sasws ) … … 1310 1326 ! Description: 1311 1327 ! ------------ 1312 !> Allocating memory for upward and downward-facing horizontal surface types, 1313 !> except for top fluxes. 1328 !> Allocating memory for upward and downward-facing horizontal surface types, 1329 !> except for top fluxes. 1314 1330 !------------------------------------------------------------------------------! 1315 1331 SUBROUTINE allocate_surface_attributes_h( surfaces, & … … 1326 1342 1327 1343 ! 1328 !-- Allocate arrays for start and end index of horizontal surface type 1344 !-- Allocate arrays for start and end index of horizontal surface type 1329 1345 !-- for each (j,i)-grid point. This is required e.g. in diffion_x, which is 1330 !-- called for each (j,i). In order to find the location where the 1331 !-- respective flux is store within the surface-type, start- and end- 1346 !-- called for each (j,i). In order to find the location where the 1347 !-- respective flux is store within the surface-type, start- and end- 1332 1348 !-- index are stored for each (j,i). For example, each (j,i) can have 1333 1349 !-- several entries where fluxes for horizontal surfaces might be stored, … … 1370 1386 ! 1371 1387 !-- Vertical momentum fluxes of u and v 1372 ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 1373 ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 1388 ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 1389 ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 1374 1390 ! 1375 1391 !-- Required in production_e 1376 IF ( .NOT. constant_diffusion ) THEN 1377 ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 1392 IF ( .NOT. constant_diffusion ) THEN 1393 ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 1378 1394 ALLOCATE ( surfaces%v_0(1:surfaces%ns) ) 1379 ENDIF 1395 ENDIF 1380 1396 ! 1381 1397 !-- Characteristic temperature and surface flux of sensible heat 1382 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 1398 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 1383 1399 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1384 1400 ! 1385 1401 !-- Surface temperature 1386 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 1402 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 1387 1403 ! 1388 1404 !-- Characteristic humidity, surface flux of latent heat, and surface virtual potential temperature 1389 1405 IF ( humidity ) THEN 1390 ALLOCATE ( surfaces%qs(1:surfaces%ns) ) 1391 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1392 ALLOCATE ( surfaces%q_surface(1:surfaces%ns) ) 1393 ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) ) 1394 ENDIF 1406 ALLOCATE ( surfaces%qs(1:surfaces%ns) ) 1407 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1408 ALLOCATE ( surfaces%q_surface(1:surfaces%ns) ) 1409 ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) ) 1410 ENDIF 1395 1411 1396 1412 ! 1397 1413 !-- Characteristic scalar and surface flux of scalar 1398 1414 IF ( passive_scalar ) THEN 1399 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 1400 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1401 ENDIF 1415 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 1416 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1417 ENDIF 1402 1418 ! 1403 1419 !-- Scaling parameter (cs*) and surface flux of chemical species 1404 1420 IF ( air_chemistry ) THEN 1405 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 1406 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1407 ENDIF 1421 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 1422 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1423 ENDIF 1408 1424 ! 1409 1425 !-- Arrays for storing potential temperature and … … 1413 1429 ALLOCATE ( surfaces%vpt1(1:surfaces%ns) ) 1414 1430 ! 1415 !-- 1431 !-- 1416 1432 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1417 1433 ALLOCATE ( surfaces%qcs(1:surfaces%ns) ) … … 1421 1437 ENDIF 1422 1438 ! 1423 !-- 1439 !-- 1424 1440 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1425 1441 ALLOCATE ( surfaces%qrs(1:surfaces%ns) ) … … 1428 1444 ALLOCATE ( surfaces%nrsws(1:surfaces%ns) ) 1429 1445 ENDIF 1446 1447 ! 1448 !-- 1449 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension) THEN 1450 ALLOCATE ( surfaces%qis(1:surfaces%ns) ) 1451 ALLOCATE ( surfaces%nis(1:surfaces%ns) ) 1452 ALLOCATE ( surfaces%qisws(1:surfaces%ns) ) 1453 ALLOCATE ( surfaces%nisws(1:surfaces%ns) ) 1454 ENDIF 1455 1430 1456 ! 1431 1457 !-- Salinity surface flux … … 1445 1471 1446 1472 IMPLICIT NONE 1447 1473 1448 1474 TYPE(surf_type) :: surfaces !< respective surface type 1449 1475 1450 1476 !$ACC EXIT DATA & 1451 1477 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & … … 1473 1499 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1474 1500 ENDIF 1475 1501 1476 1502 END SUBROUTINE exit_surface_attributes_h 1477 1503 #endif … … 1522 1548 ! Description: 1523 1549 ! ------------ 1524 !> Deallocating memory for model-top fluxes 1550 !> Deallocating memory for model-top fluxes 1525 1551 !------------------------------------------------------------------------------! 1526 1552 SUBROUTINE deallocate_surface_attributes_h_top( surfaces ) … … 1539 1565 DEALLOCATE ( surfaces%k ) 1540 1566 1541 IF ( .NOT. constant_diffusion ) THEN 1542 DEALLOCATE ( surfaces%u_0 ) 1567 IF ( .NOT. constant_diffusion ) THEN 1568 DEALLOCATE ( surfaces%u_0 ) 1543 1569 DEALLOCATE ( surfaces%v_0 ) 1544 ENDIF 1570 ENDIF 1545 1571 ! 1546 1572 !-- Vertical momentum fluxes of u and v 1547 DEALLOCATE ( surfaces%usws ) 1548 DEALLOCATE ( surfaces%vsws ) 1573 DEALLOCATE ( surfaces%usws ) 1574 DEALLOCATE ( surfaces%vsws ) 1549 1575 ! 1550 1576 !-- Sensible heat flux … … 1553 1579 !-- Latent heat flux 1554 1580 IF ( humidity .OR. coupling_mode == 'ocean_to_atmosphere') THEN 1555 DEALLOCATE ( surfaces%qsws ) 1556 ENDIF 1581 DEALLOCATE ( surfaces%qsws ) 1582 ENDIF 1557 1583 ! 1558 1584 !-- Scalar flux 1559 1585 IF ( passive_scalar ) THEN 1560 DEALLOCATE ( surfaces%ssws ) 1561 ENDIF 1586 DEALLOCATE ( surfaces%ssws ) 1587 ENDIF 1562 1588 ! 1563 1589 !-- Chemical species flux 1564 1590 IF ( air_chemistry ) THEN 1565 DEALLOCATE ( surfaces%cssws ) 1566 ENDIF 1567 ! 1568 !-- 1591 DEALLOCATE ( surfaces%cssws ) 1592 ENDIF 1593 ! 1594 !-- 1569 1595 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1570 1596 DEALLOCATE ( surfaces%qcsws ) … … 1572 1598 ENDIF 1573 1599 ! 1574 !-- 1600 !-- 1575 1601 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1576 1602 DEALLOCATE ( surfaces%qrsws ) 1577 1603 DEALLOCATE ( surfaces%nrsws ) 1578 1604 ENDIF 1605 1606 ! 1607 !-- 1608 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension) THEN 1609 DEALLOCATE ( surfaces%qisws ) 1610 DEALLOCATE ( surfaces%nisws ) 1611 ENDIF 1579 1612 ! 1580 1613 !-- Salinity flux … … 1587 1620 ! Description: 1588 1621 ! ------------ 1589 !> Allocating memory for model-top fluxes 1622 !> Allocating memory for model-top fluxes 1590 1623 !------------------------------------------------------------------------------! 1591 1624 SUBROUTINE allocate_surface_attributes_h_top( surfaces, & … … 1611 1644 ALLOCATE ( surfaces%k(1:surfaces%ns) ) 1612 1645 1613 IF ( .NOT. constant_diffusion ) THEN 1614 ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 1646 IF ( .NOT. constant_diffusion ) THEN 1647 ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 1615 1648 ALLOCATE ( surfaces%v_0(1:surfaces%ns) ) 1616 ENDIF 1649 ENDIF 1617 1650 ! 1618 1651 !-- Vertical momentum fluxes of u and v 1619 ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 1620 ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 1652 ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 1653 ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 1621 1654 ! 1622 1655 !-- Sensible heat flux … … 1625 1658 !-- Latent heat flux 1626 1659 IF ( humidity .OR. coupling_mode == 'ocean_to_atmosphere') THEN 1627 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1628 ENDIF 1660 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1661 ENDIF 1629 1662 ! 1630 1663 !-- Scalar flux 1631 1664 IF ( passive_scalar ) THEN 1632 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1633 ENDIF 1665 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1666 ENDIF 1634 1667 ! 1635 1668 !-- Chemical species flux 1636 1669 IF ( air_chemistry ) THEN 1637 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1638 ENDIF 1639 ! 1640 !-- 1670 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1671 ENDIF 1672 ! 1673 !-- 1641 1674 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1642 1675 ALLOCATE ( surfaces%qcsws(1:surfaces%ns) ) … … 1644 1677 ENDIF 1645 1678 ! 1646 !-- 1679 !-- 1647 1680 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1648 1681 ALLOCATE ( surfaces%qrsws(1:surfaces%ns) ) 1649 1682 ALLOCATE ( surfaces%nrsws(1:surfaces%ns) ) 1683 ENDIF 1684 1685 ! 1686 !-- 1687 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension) THEN 1688 ALLOCATE ( surfaces%qisws(1:surfaces%ns) ) 1689 ALLOCATE ( surfaces%nisws(1:surfaces%ns) ) 1650 1690 ENDIF 1651 1691 ! … … 1665 1705 1666 1706 IMPLICIT NONE 1667 1707 1668 1708 TYPE(surf_type) :: surfaces !< respective surface type 1669 1709 1670 1710 !$ACC EXIT DATA & 1671 1711 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & … … 1683 1723 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1684 1724 ENDIF 1685 1725 1686 1726 END SUBROUTINE exit_surface_attributes_h_top 1687 1727 #endif … … 1721 1761 ! Description: 1722 1762 ! ------------ 1723 !> Deallocating memory for vertical surface types. 1763 !> Deallocating memory for vertical surface types. 1724 1764 !------------------------------------------------------------------------------! 1725 1765 SUBROUTINE deallocate_surface_attributes_v( surfaces ) … … 1731 1771 1732 1772 ! 1733 !-- Allocate arrays for start and end index of vertical surface type 1773 !-- Allocate arrays for start and end index of vertical surface type 1734 1774 !-- for each (j,i)-grid point. This is required in diffion_x, which is 1735 !-- called for each (j,i). In order to find the location where the 1736 !-- respective flux is store within the surface-type, start- and end- 1775 !-- called for each (j,i). In order to find the location where the 1776 !-- respective flux is store within the surface-type, start- and end- 1737 1777 !-- index are stored for each (j,i). For example, each (j,i) can have 1738 !-- several entries where fluxes for vertical surfaces might be stored. 1739 !-- In the flat case, where no vertical walls exit, set indicies such 1740 !-- that loop in diffusion routines will not be entered. 1778 !-- several entries where fluxes for vertical surfaces might be stored. 1779 !-- In the flat case, where no vertical walls exit, set indicies such 1780 !-- that loop in diffusion routines will not be entered. 1741 1781 DEALLOCATE ( surfaces%start_index ) 1742 1782 DEALLOCATE ( surfaces%end_index ) … … 1766 1806 ! 1767 1807 !-- Allocate Obukhov length and bulk Richardson number. Actually, at 1768 !-- vertical surfaces these are only required for natural surfaces. 1808 !-- vertical surfaces these are only required for natural surfaces. 1769 1809 !-- for natural land surfaces 1770 DEALLOCATE( surfaces%ol ) 1771 DEALLOCATE( surfaces%rib ) 1772 ! 1773 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- 1810 DEALLOCATE( surfaces%ol ) 1811 DEALLOCATE( surfaces%rib ) 1812 ! 1813 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- 1774 1814 !-- and south-facing surfaces, for v at east- and west-facing surfaces. 1775 1815 DEALLOCATE ( surfaces%mom_flux_uv ) 1776 1816 ! 1777 1817 !-- Allocate array for surface momentum flux for w - wsus and wsvs 1778 DEALLOCATE ( surfaces%mom_flux_w ) 1779 ! 1780 !-- Allocate array for surface momentum flux for subgrid-scale tke wsus and 1818 DEALLOCATE ( surfaces%mom_flux_w ) 1819 ! 1820 !-- Allocate array for surface momentum flux for subgrid-scale tke wsus and 1781 1821 !-- wsvs; first index usvs or vsws, second index for wsus or wsvs, depending 1782 1822 !-- on surface. 1783 DEALLOCATE ( surfaces%mom_flux_tke ) 1823 DEALLOCATE ( surfaces%mom_flux_tke ) 1784 1824 ! 1785 1825 !-- Characteristic temperature and surface flux of sensible heat 1786 DEALLOCATE ( surfaces%ts ) 1826 DEALLOCATE ( surfaces%ts ) 1787 1827 DEALLOCATE ( surfaces%shf ) 1788 1828 ! 1789 1829 !-- surface temperature 1790 DEALLOCATE ( surfaces%pt_surface ) 1830 DEALLOCATE ( surfaces%pt_surface ) 1791 1831 ! 1792 1832 !-- Characteristic humidity and surface flux of latent heat 1793 1833 IF ( humidity ) THEN 1794 DEALLOCATE ( surfaces%qs ) 1795 DEALLOCATE ( surfaces%qsws ) 1834 DEALLOCATE ( surfaces%qs ) 1835 DEALLOCATE ( surfaces%qsws ) 1796 1836 DEALLOCATE ( surfaces%q_surface ) 1797 1837 DEALLOCATE ( surfaces%vpt_surface ) 1798 ENDIF 1838 ENDIF 1799 1839 ! 1800 1840 !-- Characteristic scalar and surface flux of scalar 1801 1841 IF ( passive_scalar ) THEN 1802 DEALLOCATE ( surfaces%ss ) 1803 DEALLOCATE ( surfaces%ssws ) 1842 DEALLOCATE ( surfaces%ss ) 1843 DEALLOCATE ( surfaces%ssws ) 1804 1844 ENDIF 1805 1845 ! 1806 1846 !-- Scaling parameter (cs*) and surface flux of chemical species 1807 1847 IF ( air_chemistry ) THEN 1808 DEALLOCATE ( surfaces%css ) 1809 DEALLOCATE ( surfaces%cssws ) 1810 ENDIF 1848 DEALLOCATE ( surfaces%css ) 1849 DEALLOCATE ( surfaces%cssws ) 1850 ENDIF 1811 1851 ! 1812 1852 !-- Arrays for storing potential temperature and … … 1829 1869 DEALLOCATE ( surfaces%nrsws ) 1830 1870 ENDIF 1871 1872 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension) THEN 1873 DEALLOCATE ( surfaces%qis ) 1874 DEALLOCATE ( surfaces%nis ) 1875 DEALLOCATE ( surfaces%qisws ) 1876 DEALLOCATE ( surfaces%nisws ) 1877 ENDIF 1878 1831 1879 ! 1832 1880 !-- Salinity surface flux … … 1839 1887 ! Description: 1840 1888 ! ------------ 1841 !> Allocating memory for vertical surface types. 1889 !> Allocating memory for vertical surface types. 1842 1890 !------------------------------------------------------------------------------! 1843 1891 SUBROUTINE allocate_surface_attributes_v( surfaces, & … … 1854 1902 1855 1903 ! 1856 !-- Allocate arrays for start and end index of vertical surface type 1904 !-- Allocate arrays for start and end index of vertical surface type 1857 1905 !-- for each (j,i)-grid point. This is required in diffion_x, which is 1858 !-- called for each (j,i). In order to find the location where the 1859 !-- respective flux is store within the surface-type, start- and end- 1906 !-- called for each (j,i). In order to find the location where the 1907 !-- respective flux is store within the surface-type, start- and end- 1860 1908 !-- index are stored for each (j,i). For example, each (j,i) can have 1861 !-- several entries where fluxes for vertical surfaces might be stored. 1862 !-- In the flat case, where no vertical walls exit, set indicies such 1863 !-- that loop in diffusion routines will not be entered. 1909 !-- several entries where fluxes for vertical surfaces might be stored. 1910 !-- In the flat case, where no vertical walls exit, set indicies such 1911 !-- that loop in diffusion routines will not be entered. 1864 1912 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1865 1913 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) … … 1891 1939 ! 1892 1940 !-- Allocate Obukhov length and bulk Richardson number. Actually, at 1893 !-- vertical surfaces these are only required for natural surfaces. 1941 !-- vertical surfaces these are only required for natural surfaces. 1894 1942 !-- for natural land surfaces 1895 ALLOCATE( surfaces%ol(1:surfaces%ns) ) 1896 ALLOCATE( surfaces%rib(1:surfaces%ns) ) 1897 ! 1898 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- 1943 ALLOCATE( surfaces%ol(1:surfaces%ns) ) 1944 ALLOCATE( surfaces%rib(1:surfaces%ns) ) 1945 ! 1946 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- 1899 1947 !-- and south-facing surfaces, for v at east- and west-facing surfaces. 1900 1948 ALLOCATE ( surfaces%mom_flux_uv(1:surfaces%ns) ) 1901 1949 ! 1902 1950 !-- Allocate array for surface momentum flux for w - wsus and wsvs 1903 ALLOCATE ( surfaces%mom_flux_w(1:surfaces%ns) ) 1904 ! 1905 !-- Allocate array for surface momentum flux for subgrid-scale tke wsus and 1951 ALLOCATE ( surfaces%mom_flux_w(1:surfaces%ns) ) 1952 ! 1953 !-- Allocate array for surface momentum flux for subgrid-scale tke wsus and 1906 1954 !-- wsvs; first index usvs or vsws, second index for wsus or wsvs, depending 1907 1955 !-- on surface. 1908 ALLOCATE ( surfaces%mom_flux_tke(0:1,1:surfaces%ns) ) 1956 ALLOCATE ( surfaces%mom_flux_tke(0:1,1:surfaces%ns) ) 1909 1957 ! 1910 1958 !-- Characteristic temperature and surface flux of sensible heat 1911 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 1959 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 1912 1960 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1913 1961 ! 1914 1962 !-- surface temperature 1915 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 1963 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 1916 1964 ! 1917 1965 !-- Characteristic humidity and surface flux of latent heat 1918 1966 IF ( humidity ) THEN 1919 ALLOCATE ( surfaces%qs(1:surfaces%ns) ) 1920 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1967 ALLOCATE ( surfaces%qs(1:surfaces%ns) ) 1968 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1921 1969 ALLOCATE ( surfaces%q_surface(1:surfaces%ns) ) 1922 ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) ) 1923 ENDIF 1970 ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) ) 1971 ENDIF 1924 1972 ! 1925 1973 !-- Characteristic scalar and surface flux of scalar 1926 1974 IF ( passive_scalar ) THEN 1927 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 1928 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1975 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 1976 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1929 1977 ENDIF 1930 1978 ! 1931 1979 !-- Scaling parameter (cs*) and surface flux of chemical species 1932 1980 IF ( air_chemistry ) THEN 1933 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 1934 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1935 ENDIF 1981 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 1982 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1983 ENDIF 1936 1984 ! 1937 1985 !-- Arrays for storing potential temperature and … … 1954 2002 ALLOCATE ( surfaces%nrsws(1:surfaces%ns) ) 1955 2003 ENDIF 2004 2005 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension) THEN 2006 ALLOCATE ( surfaces%qis(1:surfaces%ns) ) 2007 ALLOCATE ( surfaces%nis(1:surfaces%ns) ) 2008 ALLOCATE ( surfaces%qisws(1:surfaces%ns) ) 2009 ALLOCATE ( surfaces%nisws(1:surfaces%ns) ) 2010 ENDIF 1956 2011 ! 1957 2012 !-- Salinity surface flux … … 1964 2019 ! Description: 1965 2020 ! ------------ 1966 !> Exit memory for vertical surface types. 2021 !> Exit memory for vertical surface types. 1967 2022 !------------------------------------------------------------------------------! 1968 2023 #if defined( _OPENACC ) … … 1996 2051 ! Description: 1997 2052 ! ------------ 1998 !> Enter memory for vertical surface types. 2053 !> Enter memory for vertical surface types. 1999 2054 !------------------------------------------------------------------------------! 2000 2055 #if defined( _OPENACC ) 2001 2056 SUBROUTINE enter_surface_attributes_v( surfaces ) 2002 2057 2003 2058 IMPLICIT NONE 2004 2059 2005 2060 TYPE(surf_type) :: surfaces !< respective surface type 2006 2061 2007 2062 !$ACC ENTER DATA & 2008 2063 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & … … 2021 2076 !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) & 2022 2077 !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) 2023 2078 2024 2079 END SUBROUTINE enter_surface_attributes_v 2025 2080 #endif … … 2028 2083 ! Description: 2029 2084 ! ------------ 2030 !> Initialize surface elements, i.e. set initial values for surface fluxes, 2031 !> friction velocity, calcuation of start/end indices, etc. . 2032 !> Please note, further initialization concerning 2033 !> special surface characteristics, e.g. soil- and vegatation type, 2034 !> building type, etc., is done in the land-surface and urban-surface module, 2035 !> respectively. 2085 !> Initialize surface elements, i.e. set initial values for surface fluxes, 2086 !> friction velocity, calcuation of start/end indices, etc. . 2087 !> Please note, further initialization concerning 2088 !> special surface characteristics, e.g. soil- and vegatation type, 2089 !> building type, etc., is done in the land-surface and urban-surface module, 2090 !> respectively. 2036 2091 !------------------------------------------------------------------------------! 2037 2092 SUBROUTINE init_surfaces … … 2054 2109 INTEGER(iwp), DIMENSION(0:2) :: num_def_h_kji !< dummy to determing local end index in surface type for given (j,i), for horizonal default surfaces 2055 2110 INTEGER(iwp), DIMENSION(0:2) :: start_index_def_h !< dummy to determing local start index in surface type for given (j,i), for horizontal default surfaces 2056 2111 2057 2112 INTEGER(iwp), DIMENSION(0:3) :: num_def_v !< current number of vertical surface element, default type 2058 2113 INTEGER(iwp), DIMENSION(0:3) :: num_def_v_kji !< dummy to determing local end index in surface type for given (j,i), for vertical default surfaces … … 2068 2123 LOGICAL :: building !< flag indicating building grid point 2069 2124 LOGICAL :: terrain !< flag indicating natural terrain grid point 2070 LOGICAL :: unresolved_building !< flag indicating a grid point where actually a building is defined but not resolved by the vertical grid 2071 ! 2072 !-- Set offset indices, i.e. index difference between surface element and 2125 LOGICAL :: unresolved_building !< flag indicating a grid point where actually a building is defined but not resolved by the vertical grid 2126 ! 2127 !-- Set offset indices, i.e. index difference between surface element and 2073 2128 !-- surface-bounded grid point. 2074 2129 !-- Upward facing - no horizontal offsets … … 2127 2182 2128 2183 ! 2129 !-- Initialize surface attributes, store indicies, surfaces orientation, etc., 2184 !-- Initialize surface attributes, store indicies, surfaces orientation, etc., 2130 2185 num_def_h(0:2) = 1 2131 2186 num_def_v(0:3) = 1 … … 2162 2217 ! 2163 2218 !-- Upward-facing surface. Distinguish between differet surface types. 2164 !-- To do, think about method to flag natural and non-natural 2165 !-- surfaces. 2166 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i), 0 ) ) THEN 2219 !-- To do, think about method to flag natural and non-natural 2220 !-- surfaces. 2221 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i), 0 ) ) THEN 2167 2222 ! 2168 2223 !-- Determine flags indicating terrain or building … … 2171 2226 building = BTEST( wall_flags_total_0(k-1,j,i), 6 ) .OR. & 2172 2227 topo_no_distinct 2173 2174 ! 2175 !-- unresolved_building indicates a surface with equal height 2228 2229 ! 2230 !-- unresolved_building indicates a surface with equal height 2176 2231 !-- as terrain but with a non-grid resolved building on top. 2177 2232 !-- These surfaces will be flagged as urban surfaces. … … 2179 2234 .AND. BTEST( wall_flags_total_0(k-1,j,i), 6 ) 2180 2235 ! 2181 !-- Natural surface type 2236 !-- Natural surface type 2182 2237 IF ( land_surface .AND. terrain .AND. & 2183 2238 .NOT. unresolved_building ) THEN … … 2186 2241 num_lsm_h, & 2187 2242 num_lsm_h_kji, & 2188 .TRUE., .FALSE. ) 2243 .TRUE., .FALSE. ) 2189 2244 ! 2190 2245 !-- Urban surface tpye … … 2194 2249 num_usm_h, & 2195 2250 num_usm_h_kji, & 2196 .TRUE., .FALSE. ) 2251 .TRUE., .FALSE. ) 2197 2252 ! 2198 2253 !-- Default surface type … … 2202 2257 num_def_h(0), & 2203 2258 num_def_h_kji(0),& 2204 .TRUE., .FALSE. ) 2259 .TRUE., .FALSE. ) 2205 2260 ENDIF 2206 ENDIF 2207 ! 2208 !-- downward-facing surface, first, model top. Please note, 2209 !-- for the moment, downward-facing surfaces are always of 2261 ENDIF 2262 ! 2263 !-- downward-facing surface, first, model top. Please note, 2264 !-- for the moment, downward-facing surfaces are always of 2210 2265 !-- default type 2211 2266 IF ( k == nzt .AND. use_top_fluxes ) THEN … … 2213 2268 num_def_h(2), num_def_h_kji(2) ) 2214 2269 ! 2215 !-- Check for any other downward-facing surface. So far only for 2270 !-- Check for any other downward-facing surface. So far only for 2216 2271 !-- default surface type. 2217 2272 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i), 0 ) ) THEN … … 2220 2275 num_def_h(1), & 2221 2276 num_def_h_kji(1), & 2222 .FALSE., .TRUE. ) 2223 ENDIF 2277 .FALSE., .TRUE. ) 2278 ENDIF 2224 2279 ! 2225 2280 !-- Check for vertical walls and, if required, initialize it. … … 2235 2290 unresolved_building = BTEST( wall_flags_total_0(k,j-1,i), 5 ) & 2236 2291 .AND. BTEST( wall_flags_total_0(k,j-1,i), 6 ) 2237 2292 2238 2293 IF ( land_surface .AND. terrain .AND. & 2239 2294 .NOT. unresolved_building ) THEN … … 2242 2297 num_lsm_v(0), & 2243 2298 num_lsm_v_kji(0), & 2244 .FALSE., .FALSE., & 2299 .FALSE., .FALSE., & 2245 2300 .FALSE., .TRUE. ) 2246 2301 ELSEIF ( urban_surface .AND. building ) THEN … … 2249 2304 num_usm_v(0), & 2250 2305 num_usm_v_kji(0), & 2251 .FALSE., .FALSE., & 2306 .FALSE., .FALSE., & 2252 2307 .FALSE., .TRUE. ) 2253 2308 ELSE … … 2256 2311 num_def_v(0), & 2257 2312 num_def_v_kji(0), & 2258 .FALSE., .FALSE., & 2259 .FALSE., .TRUE. ) 2313 .FALSE., .FALSE., & 2314 .FALSE., .TRUE. ) 2260 2315 ENDIF 2261 2316 ENDIF … … 2269 2324 building = BTEST( wall_flags_total_0(k,j+1,i), 6 ) .OR. & 2270 2325 topo_no_distinct 2271 2326 2272 2327 unresolved_building = BTEST( wall_flags_total_0(k,j+1,i), 5 ) & 2273 2328 .AND. BTEST( wall_flags_total_0(k,j+1,i), 6 ) 2274 2329 2275 2330 IF ( land_surface .AND. terrain .AND. & 2276 2331 .NOT. unresolved_building ) THEN … … 2294 2349 num_def_v_kji(1), & 2295 2350 .FALSE., .FALSE., & 2296 .TRUE., .FALSE. ) 2351 .TRUE., .FALSE. ) 2297 2352 ENDIF 2298 2353 ENDIF … … 2306 2361 building = BTEST( wall_flags_total_0(k,j,i-1), 6 ) .OR. & 2307 2362 topo_no_distinct 2308 2363 2309 2364 unresolved_building = BTEST( wall_flags_total_0(k,j,i-1), 5 ) & 2310 2365 .AND. BTEST( wall_flags_total_0(k,j,i-1), 6 ) 2311 2366 2312 2367 IF ( land_surface .AND. terrain .AND. & 2313 2368 .NOT. unresolved_building ) THEN … … 2331 2386 num_def_v_kji(2), & 2332 2387 .TRUE., .FALSE., & 2333 .FALSE., .FALSE. ) 2388 .FALSE., .FALSE. ) 2334 2389 ENDIF 2335 ENDIF 2336 ! 2390 ENDIF 2391 ! 2337 2392 !-- westward-facing surface 2338 2393 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) ) THEN … … 2343 2398 building = BTEST( wall_flags_total_0(k,j,i+1), 6 ) .OR. & 2344 2399 topo_no_distinct 2345 2400 2346 2401 unresolved_building = BTEST( wall_flags_total_0(k,j,i+1), 5 ) & 2347 2402 .AND. BTEST( wall_flags_total_0(k,j,i+1), 6 ) 2348 2403 2349 2404 IF ( land_surface .AND. terrain .AND. & 2350 2405 .NOT. unresolved_building ) THEN … … 2368 2423 num_def_v_kji(3), & 2369 2424 .FALSE., .TRUE., & 2370 .FALSE., .FALSE. ) 2425 .FALSE., .FALSE. ) 2371 2426 ENDIF 2372 2427 ENDIF 2373 2428 ENDIF 2374 2429 2375 2430 2376 2431 ENDDO 2377 2432 ! 2378 !-- Determine start- and end-index at grid point (j,i). Also, for 2379 !-- horizontal surfaces more than 1 horizontal surface element can 2433 !-- Determine start- and end-index at grid point (j,i). Also, for 2434 !-- horizontal surfaces more than 1 horizontal surface element can 2380 2435 !-- exist at grid point (j,i) if overhanging structures are present. 2381 2436 !-- Upward-facing surfaces … … 2393 2448 ! 2394 2449 !-- Downward-facing surfaces, except model top 2395 surf_def_h(1)%start_index(j,i) = start_index_def_h(1) 2450 surf_def_h(1)%start_index(j,i) = start_index_def_h(1) 2396 2451 surf_def_h(1)%end_index(j,i) = surf_def_h(1)%start_index(j,i) + & 2397 2452 num_def_h_kji(1) - 1 … … 2399 2454 ! 2400 2455 !-- Downward-facing surfaces -- model top fluxes 2401 surf_def_h(2)%start_index(j,i) = start_index_def_h(2) 2456 surf_def_h(2)%start_index(j,i) = start_index_def_h(2) 2402 2457 surf_def_h(2)%end_index(j,i) = surf_def_h(2)%start_index(j,i) + & 2403 2458 num_def_h_kji(2) - 1 … … 2422 2477 surf_def_v(2)%start_index(j,i) = start_index_def_v(2) 2423 2478 surf_def_v(3)%start_index(j,i) = start_index_def_v(3) 2424 surf_def_v(0)%end_index(j,i) = start_index_def_v(0) + & 2479 surf_def_v(0)%end_index(j,i) = start_index_def_v(0) + & 2425 2480 num_def_v_kji(0) - 1 2426 2481 surf_def_v(1)%end_index(j,i) = start_index_def_v(1) + & … … 2440 2495 surf_lsm_v(2)%start_index(j,i) = start_index_lsm_v(2) 2441 2496 surf_lsm_v(3)%start_index(j,i) = start_index_lsm_v(3) 2442 surf_lsm_v(0)%end_index(j,i) = start_index_lsm_v(0) + & 2497 surf_lsm_v(0)%end_index(j,i) = start_index_lsm_v(0) + & 2443 2498 num_lsm_v_kji(0) - 1 2444 2499 surf_lsm_v(1)%end_index(j,i) = start_index_lsm_v(1) + & … … 2458 2513 surf_usm_v(2)%start_index(j,i) = start_index_usm_v(2) 2459 2514 surf_usm_v(3)%start_index(j,i) = start_index_usm_v(3) 2460 surf_usm_v(0)%end_index(j,i) = start_index_usm_v(0) + & 2515 surf_usm_v(0)%end_index(j,i) = start_index_usm_v(0) + & 2461 2516 num_usm_v_kji(0) - 1 2462 2517 surf_usm_v(1)%end_index(j,i) = start_index_usm_v(1) + & … … 2480 2535 ! Description: 2481 2536 ! ------------ 2482 !> Initialize horizontal surface elements, upward- and downward-facing. 2537 !> Initialize horizontal surface elements, upward- and downward-facing. 2483 2538 !> Note, horizontal surface type alsw comprises model-top fluxes, which are, 2484 !> initialized in a different routine. 2539 !> initialized in a different routine. 2485 2540 !------------------------------------------------------------------------------! 2486 2541 SUBROUTINE initialize_horizontal_surfaces( k, j, i, surf, num_h, & 2487 2542 num_h_kji, upward_facing, & 2488 downward_facing ) 2489 2490 IMPLICIT NONE 2543 downward_facing ) 2544 2545 IMPLICIT NONE 2491 2546 2492 2547 INTEGER(iwp) :: i !< running index x-direction … … 2509 2564 surf%k(num_h) = k 2510 2565 ! 2511 !-- Surface orientation, bit 0 is set to 1 for upward-facing surfaces, 2566 !-- Surface orientation, bit 0 is set to 1 for upward-facing surfaces, 2512 2567 !-- bit 1 is for downward-facing surfaces. 2513 2568 IF ( upward_facing ) surf%facing(num_h) = IBSET( surf%facing(num_h), 0 ) … … 2520 2575 surf%z_mo(num_h) = zw(k) - zu(k) 2521 2576 ENDIF 2522 2577 2523 2578 surf%z0(num_h) = roughness_length 2524 2579 surf%z0h(num_h) = z0h_factor * roughness_length 2525 surf%z0q(num_h) = z0h_factor * roughness_length 2580 surf%z0q(num_h) = z0h_factor * roughness_length 2526 2581 ! 2527 2582 !-- Initialization in case of 1D pre-cursor run … … 2553 2608 surf%ol(num_h) = surf%z_mo(num_h) / zeta_min 2554 2609 ! 2555 !-- Very small number is required for calculation of Obukhov length 2556 !-- at first timestep 2557 surf%us(num_h) = 1E-30_wp 2610 !-- Very small number is required for calculation of Obukhov length 2611 !-- at first timestep 2612 surf%us(num_h) = 1E-30_wp 2558 2613 surf%usws(num_h) = 0.0_wp 2559 2614 surf%vsws(num_h) = 0.0_wp 2560 2561 ENDIF 2562 2563 surf%rib(num_h) = 0.0_wp 2615 2616 ENDIF 2617 2618 surf%rib(num_h) = 0.0_wp 2564 2619 surf%uvw_abs(num_h) = 0.0_wp 2565 2620 2566 IF ( .NOT. constant_diffusion ) THEN 2567 surf%u_0(num_h) = 0.0_wp 2621 IF ( .NOT. constant_diffusion ) THEN 2622 surf%u_0(num_h) = 0.0_wp 2568 2623 surf%v_0(num_h) = 0.0_wp 2569 ENDIF 2624 ENDIF 2570 2625 2571 2626 surf%ts(num_h) = 0.0_wp … … 2573 2628 !-- Set initial value for surface temperature 2574 2629 surf%pt_surface(num_h) = pt_surface 2575 2630 2576 2631 IF ( humidity ) THEN 2577 2632 surf%qs(num_h) = 0.0_wp … … 2579 2634 surf%qcs(num_h) = 0.0_wp 2580 2635 surf%ncs(num_h) = 0.0_wp 2581 2636 2582 2637 surf%qcsws(num_h) = 0.0_wp 2583 2638 surf%ncsws(num_h) = 0.0_wp … … 2587 2642 surf%qrs(num_h) = 0.0_wp 2588 2643 surf%nrs(num_h) = 0.0_wp 2589 2644 2590 2645 surf%qrsws(num_h) = 0.0_wp 2591 2646 surf%nrsws(num_h) = 0.0_wp … … 2594 2649 surf%qv1(num_h) = 0.0_wp 2595 2650 surf%vpt1(num_h) = 0.0_wp 2596 2651 2597 2652 ENDIF 2598 2653 2654 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension) THEN 2655 surf%qis(num_h) = 0.0_wp 2656 surf%nis(num_h) = 0.0_wp 2657 2658 surf%qisws(num_h) = 0.0_wp 2659 surf%nisws(num_h) = 0.0_wp 2660 ENDIF 2661 2662 2599 2663 surf%q_surface(num_h) = q_surface 2600 2664 surf%vpt_surface(num_h) = surf%pt_surface(num_h) * & … … 2607 2671 IF ( air_chemistry ) surf%css(lsp,num_h) = 0.0_wp 2608 2672 ! 2609 !-- Ensure that fluxes of compounds which are not specified in 2673 !-- Ensure that fluxes of compounds which are not specified in 2610 2674 !-- namelist are all zero --> kanani: revise 2611 2675 IF ( air_chemistry ) surf%cssws(lsp,num_h) = 0.0_wp … … 2618 2682 IF ( upward_facing ) THEN 2619 2683 IF ( constant_heatflux ) THEN 2620 ! 2621 !-- Initialize surface heatflux. However, skip this for now if 2684 ! 2685 !-- Initialize surface heatflux. However, skip this for now if 2622 2686 !-- if random_heatflux is set. This case, shf is initialized later. 2623 2687 IF ( .NOT. random_heatflux ) THEN … … 2625 2689 heatflux_input_conversion(k-1) 2626 2690 ! 2627 !-- Check if surface heat flux might be replaced by 2691 !-- Check if surface heat flux might be replaced by 2628 2692 !-- prescribed wall heatflux 2629 2693 IF ( k-1 /= 0 ) THEN … … 2683 2747 ! 2684 2748 !-- Assign surface flux for each variable species 2685 IF ( TRIM( spc_names(lsp) ) == TRIM( surface_csflux_name(lsp_pr) ) ) THEN 2749 IF ( TRIM( spc_names(lsp) ) == TRIM( surface_csflux_name(lsp_pr) ) ) THEN 2686 2750 IF ( upward_facing ) THEN 2687 2751 IF ( constant_csflux(lsp_pr) ) THEN … … 2693 2757 surf%cssws(lsp,num_h) = & 2694 2758 wall_csflux(lsp,0) * & 2695 rho_air_zw(k-1) 2759 rho_air_zw(k-1) 2696 2760 ELSE 2697 2761 surf%cssws(lsp,num_h) = 0.0_wp … … 2708 2772 2709 2773 IF ( ocean_mode ) THEN 2710 IF ( upward_facing ) THEN 2774 IF ( upward_facing ) THEN 2711 2775 surf%sasws(num_h) = bottom_salinityflux * rho_air_zw(k-1) 2712 2776 ELSE … … 2718 2782 !-- Increment surface indices 2719 2783 num_h = num_h + 1 2720 num_h_kji = num_h_kji + 1 2784 num_h_kji = num_h_kji + 1 2721 2785 2722 2786 2723 2787 END SUBROUTINE initialize_horizontal_surfaces 2724 2788 2725 2789 2726 2790 !------------------------------------------------------------------------------! 2727 2791 ! Description: 2728 2792 ! ------------ 2729 !> Initialize model-top fluxes. Currently, only the heatflux and salinity flux 2793 !> Initialize model-top fluxes. Currently, only the heatflux and salinity flux 2730 2794 !> can be prescribed, latent flux is zero in this case! 2731 2795 !------------------------------------------------------------------------------! 2732 SUBROUTINE initialize_top( k, j, i, surf, num_h, num_h_kji ) 2733 2734 IMPLICIT NONE 2796 SUBROUTINE initialize_top( k, j, i, surf, num_h, num_h_kji ) 2797 2798 IMPLICIT NONE 2735 2799 2736 2800 INTEGER(iwp) :: i !< running index x-direction … … 2758 2822 ENDIF 2759 2823 ! 2760 !-- Prescribe latent heat flux at the top 2824 !-- Prescribe latent heat flux at the top 2761 2825 IF ( humidity ) THEN 2762 2826 surf%qsws(num_h) = 0.0_wp … … 2769 2833 surf%qrsws(num_h) = 0.0_wp 2770 2834 ENDIF 2835 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension ) THEN 2836 surf%nisws(num_h) = 0.0_wp 2837 surf%qisws(num_h) = 0.0_wp 2838 ENDIF 2771 2839 ENDIF 2772 2840 ! … … 2777 2845 !-- Prescribe top chemical species' flux 2778 2846 DO lsp = 1, nvar 2779 IF ( air_chemistry .AND. constant_top_csflux(lsp) ) THEN 2847 IF ( air_chemistry .AND. constant_top_csflux(lsp) ) THEN 2780 2848 surf%cssws(lsp,num_h) = top_csflux(lsp) * rho_air_zw(nzt+1) 2781 2849 ENDIF … … 2796 2864 !-- Increment surface indices 2797 2865 num_h = num_h + 1 2798 num_h_kji = num_h_kji + 1 2866 num_h_kji = num_h_kji + 1 2799 2867 2800 2868 … … 2805 2873 ! Description: 2806 2874 ! ------------ 2807 !> Initialize vertical surface elements. 2875 !> Initialize vertical surface elements. 2808 2876 !------------------------------------------------------------------------------! 2809 2877 SUBROUTINE initialize_vertical_surfaces( k, j, i, surf, num_v, & 2810 2878 num_v_kji, east_facing, & 2811 2879 west_facing, south_facing, & 2812 north_facing ) 2813 2814 IMPLICIT NONE 2815 2816 INTEGER(iwp) :: component !< index of wall_fluxes_ array for respective orientation 2880 north_facing ) 2881 2882 IMPLICIT NONE 2883 2884 INTEGER(iwp) :: component !< index of wall_fluxes_ array for respective orientation 2817 2885 INTEGER(iwp) :: i !< running index x-direction 2818 2886 INTEGER(iwp) :: j !< running index x-direction … … 2845 2913 surf%facing(num_v) = 0 2846 2914 ! 2847 !-- Surface orientation. Moreover, set component id to map wall_heatflux, 2915 !-- Surface orientation. Moreover, set component id to map wall_heatflux, 2848 2916 !-- etc., on surface type (further below) 2849 2917 IF ( north_facing ) THEN 2850 surf%facing(num_v) = 5 !IBSET( surf%facing(num_v), 0 ) 2918 surf%facing(num_v) = 5 !IBSET( surf%facing(num_v), 0 ) 2851 2919 component = 4 2852 2920 ENDIF 2853 2921 2854 2922 IF ( south_facing ) THEN 2855 surf%facing(num_v) = 6 !IBSET( surf%facing(num_v), 1 ) 2923 surf%facing(num_v) = 6 !IBSET( surf%facing(num_v), 1 ) 2856 2924 component = 3 2857 2925 ENDIF … … 2863 2931 2864 2932 IF ( west_facing ) THEN 2865 surf%facing(num_v) = 8 !IBSET( surf%facing(num_v), 3 ) 2933 surf%facing(num_v) = 8 !IBSET( surf%facing(num_v), 3 ) 2866 2934 component = 1 2867 2935 ENDIF 2868 2936 2869 2937 2870 2938 surf%z0(num_v) = roughness_length 2871 2939 surf%z0h(num_v) = z0h_factor * roughness_length … … 2894 2962 surf%qsws(num_v) = wall_humidityflux(component) 2895 2963 ! 2896 !-- Following wall fluxes are assumed to be zero 2964 !-- Following wall fluxes are assumed to be zero 2897 2965 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 2898 2966 surf%qcs(num_v) = 0.0_wp 2899 2967 surf%ncs(num_v) = 0.0_wp 2900 2968 2901 2969 surf%qcsws(num_v) = 0.0_wp 2902 2970 surf%ncsws(num_v) = 0.0_wp … … 2905 2973 surf%qrs(num_v) = 0.0_wp 2906 2974 surf%nrs(num_v) = 0.0_wp 2907 2975 2908 2976 surf%qrsws(num_v) = 0.0_wp 2909 2977 surf%nrsws(num_v) = 0.0_wp 2910 2978 ENDIF 2979 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_extension) THEN 2980 surf%qis(num_v) = 0.0_wp 2981 surf%nis(num_v) = 0.0_wp 2982 2983 surf%qisws(num_v) = 0.0_wp 2984 surf%nisws(num_v) = 0.0_wp 2985 ENDIF 2911 2986 ENDIF 2912 2987 … … 2916 2991 ENDIF 2917 2992 2918 IF ( air_chemistry ) THEN 2993 IF ( air_chemistry ) THEN 2919 2994 DO lsp = 1, nvar 2920 2995 surf%css(lsp,num_v) = 0.0_wp … … 2924 2999 2925 3000 ! 2926 !-- So far, salinityflux at vertical surfaces is simply zero 2927 !-- at the moment 3001 !-- So far, salinityflux at vertical surfaces is simply zero 3002 !-- at the moment 2928 3003 IF ( ocean_mode ) surf%sasws(num_v) = wall_salinityflux(component) 2929 3004 ! … … 2945 3020 index_space_j & 2946 3021 ) 2947 3022 2948 3023 INTEGER(iwp) :: m !< running index over surface elements 2949 3024 INTEGER(iwp) :: ns !< number of surface elements in var_surf 2950 3025 2951 3026 INTEGER(iwp), DIMENSION(1:ns) :: index_space_i !< grid indices along x direction where surface properties should be defined 2952 INTEGER(iwp), DIMENSION(1:ns) :: index_space_j !< grid indices along y direction where surface properties should be defined 2953 3027 INTEGER(iwp), DIMENSION(1:ns) :: index_space_j !< grid indices along y direction where surface properties should be defined 3028 2954 3029 REAL(wp) :: fill_value !< fill value in var_2d 2955 3030 2956 3031 REAL(wp), DIMENSION(1:ns) :: var_surf !< 1D surface variable that should be initialized 2957 3032 REAL(wp), DIMENSION(nys:nyn,nxl:nxr) :: var_2d !< input variable … … 2962 3037 ENDIF 2963 3038 ENDDO 2964 3039 2965 3040 END SUBROUTINE init_single_surface_properties 2966 3041 … … 3019 3094 ENDDO 3020 3095 ! 3021 !-- In the following, gather data from surfaces elements with the same 3096 !-- In the following, gather data from surfaces elements with the same 3022 3097 !-- facing (but possibly differt type) on 1 data-type array. 3023 3098 mm(0:2) = 1 … … 3039 3114 IF ( ALLOCATED( surf_def_h(l)%ncs ) ) & 3040 3115 surf_h(l)%ncs(mm(l)) = surf_def_h(l)%ncs(m) 3116 IF ( ALLOCATED( surf_def_h(l)%qis ) ) & 3117 surf_h(l)%qis(mm(l)) = surf_def_h(l)%qis(m) 3118 IF ( ALLOCATED( surf_def_h(l)%nis ) ) & 3119 surf_h(l)%nis(mm(l)) = surf_def_h(l)%nis(m) 3041 3120 IF ( ALLOCATED( surf_def_h(l)%qrs ) ) & 3042 3121 surf_h(l)%qrs(mm(l)) = surf_def_h(l)%qrs(m) … … 3050 3129 surf_h(l)%pt_surface(mm(l)) = surf_def_h(l)%pt_surface(m) 3051 3130 IF ( ALLOCATED( surf_def_h(l)%q_surface ) ) & 3052 surf_h(l)%q_surface(mm(l)) = surf_def_h(l)%q_surface(m) 3131 surf_h(l)%q_surface(mm(l)) = surf_def_h(l)%q_surface(m) 3053 3132 IF ( ALLOCATED( surf_def_h(l)%vpt_surface ) ) & 3054 surf_h(l)%vpt_surface(mm(l)) = surf_def_h(l)%vpt_surface(m) 3133 surf_h(l)%vpt_surface(mm(l)) = surf_def_h(l)%vpt_surface(m) 3055 3134 IF ( ALLOCATED( surf_def_h(l)%usws ) ) & 3056 3135 surf_h(l)%usws(mm(l)) = surf_def_h(l)%usws(m) … … 3063 3142 IF ( ALLOCATED( surf_def_h(l)%ssws ) ) & 3064 3143 surf_h(l)%ssws(mm(l)) = surf_def_h(l)%ssws(m) 3065 IF ( ALLOCATED( surf_def_h(l)%css ) ) THEN 3144 IF ( ALLOCATED( surf_def_h(l)%css ) ) THEN 3066 3145 DO lsp = 1,nvar 3067 3146 surf_h(l)%css(lsp,mm(l)) = surf_def_h(l)%css(lsp,m) 3068 3147 ENDDO 3069 3148 ENDIF 3070 IF ( ALLOCATED( surf_def_h(l)%cssws ) ) THEN 3149 IF ( ALLOCATED( surf_def_h(l)%cssws ) ) THEN 3071 3150 DO lsp = 1,nvar 3072 3151 surf_h(l)%cssws(lsp,mm(l)) = surf_def_h(l)%cssws(lsp,m) … … 3077 3156 IF ( ALLOCATED( surf_def_h(l)%qrsws ) ) & 3078 3157 surf_h(l)%qrsws(mm(l)) = surf_def_h(l)%qrsws(m) 3158 IF ( ALLOCATED( surf_def_h(l)%qisws ) ) & 3159 surf_h(l)%qisws(mm(l)) = surf_def_h(l)%qisws(m) 3079 3160 IF ( ALLOCATED( surf_def_h(l)%ncsws ) ) & 3080 3161 surf_h(l)%ncsws(mm(l)) = surf_def_h(l)%ncsws(m) 3162 IF ( ALLOCATED( surf_def_h(l)%nisws ) ) & 3163 surf_h(l)%nisws(mm(l)) = surf_def_h(l)%nisws(m) 3081 3164 IF ( ALLOCATED( surf_def_h(l)%nrsws ) ) & 3082 3165 surf_h(l)%nrsws(mm(l)) = surf_def_h(l)%nrsws(m) 3083 3166 IF ( ALLOCATED( surf_def_h(l)%sasws ) ) & 3084 3167 surf_h(l)%sasws(mm(l)) = surf_def_h(l)%sasws(m) 3085 3168 3086 3169 mm(l) = mm(l) + 1 3087 3170 ENDDO … … 3102 3185 IF ( ALLOCATED( surf_lsm_h%ncs ) ) & 3103 3186 surf_h(0)%ncs(mm(0)) = surf_lsm_h%ncs(m) 3187 IF ( ALLOCATED( surf_lsm_h%qis ) ) & 3188 surf_h(0)%qis(mm(0)) = surf_lsm_h%qis(m) 3189 IF ( ALLOCATED( surf_lsm_h%nis ) ) & 3190 surf_h(0)%nis(mm(0)) = surf_lsm_h%nis(m) 3104 3191 IF ( ALLOCATED( surf_lsm_h%qrs ) ) & 3105 3192 surf_h(0)%qrs(mm(0)) = surf_lsm_h%qrs(m) … … 3126 3213 IF ( ALLOCATED( surf_lsm_h%ssws ) ) & 3127 3214 surf_h(0)%ssws(mm(0)) = surf_lsm_h%ssws(m) 3128 IF ( ALLOCATED( surf_lsm_h%css ) ) THEN 3215 IF ( ALLOCATED( surf_lsm_h%css ) ) THEN 3129 3216 DO lsp = 1, nvar 3130 3217 surf_h(0)%css(lsp,mm(0)) = surf_lsm_h%css(lsp,m) … … 3134 3221 DO lsp = 1, nvar 3135 3222 surf_h(0)%cssws(lsp,mm(0)) = surf_lsm_h%cssws(lsp,m) 3136 ENDDO 3223 ENDDO 3137 3224 ENDIF 3138 3225 IF ( ALLOCATED( surf_lsm_h%qcsws ) ) & 3139 3226 surf_h(0)%qcsws(mm(0)) = surf_lsm_h%qcsws(m) 3227 IF ( ALLOCATED( surf_lsm_h%qisws ) ) & 3228 surf_h(0)%qisws(mm(0)) = surf_lsm_h%qisws(m) 3140 3229 IF ( ALLOCATED( surf_lsm_h%qrsws ) ) & 3141 3230 surf_h(0)%qrsws(mm(0)) = surf_lsm_h%qrsws(m) 3142 3231 IF ( ALLOCATED( surf_lsm_h%ncsws ) ) & 3143 3232 surf_h(0)%ncsws(mm(0)) = surf_lsm_h%ncsws(m) 3233 IF ( ALLOCATED( surf_lsm_h%nisws ) ) & 3234 surf_h(0)%nisws(mm(0)) = surf_lsm_h%nisws(m) 3144 3235 IF ( ALLOCATED( surf_lsm_h%nrsws ) ) & 3145 3236 surf_h(0)%nrsws(mm(0)) = surf_lsm_h%nrsws(m) 3146 3237 IF ( ALLOCATED( surf_lsm_h%sasws ) ) & 3147 3238 surf_h(0)%sasws(mm(0)) = surf_lsm_h%sasws(m) 3148 3239 3149 3240 mm(0) = mm(0) + 1 3150 3241 3151 3242 ENDDO 3152 3243 … … 3165 3256 IF ( ALLOCATED( surf_usm_h%ncs ) ) & 3166 3257 surf_h(0)%ncs(mm(0)) = surf_usm_h%ncs(m) 3258 IF ( ALLOCATED( surf_usm_h%qis ) ) & 3259 surf_h(0)%qis(mm(0)) = surf_usm_h%qis(m) 3260 IF ( ALLOCATED( surf_usm_h%nis ) ) & 3261 surf_h(0)%nis(mm(0)) = surf_usm_h%nis(m) 3167 3262 IF ( ALLOCATED( surf_usm_h%qrs ) ) & 3168 3263 surf_h(0)%qrs(mm(0)) = surf_usm_h%qrs(m) … … 3175 3270 IF ( ALLOCATED( surf_usm_h%pt_surface ) ) & 3176 3271 surf_h(l)%pt_surface(mm(l)) = surf_usm_h%pt_surface(m) 3177 IF ( ALLOCATED( surf_usm_h%q_surface ) )&3272 IF ( ALLOCATED( surf_usm_h%q_surface ) ) & 3178 3273 surf_h(l)%q_surface(mm(l)) = surf_usm_h%q_surface(m) 3179 3274 IF ( ALLOCATED( surf_usm_h%vpt_surface ) ) & … … 3189 3284 IF ( ALLOCATED( surf_usm_h%ssws ) ) & 3190 3285 surf_h(0)%ssws(mm(0)) = surf_usm_h%ssws(m) 3191 IF ( ALLOCATED( surf_usm_h%css ) ) THEN 3286 IF ( ALLOCATED( surf_usm_h%css ) ) THEN 3192 3287 DO lsp = 1, nvar 3193 3288 surf_h(0)%css(lsp,mm(0)) = surf_usm_h%css(lsp,m) 3194 3289 ENDDO 3195 3290 ENDIF 3196 IF ( ALLOCATED( surf_usm_h%cssws ) ) THEN 3291 IF ( ALLOCATED( surf_usm_h%cssws ) ) THEN 3197 3292 DO lsp = 1, nvar 3198 3293 surf_h(0)%cssws(lsp,mm(0)) = surf_usm_h%cssws(lsp,m) … … 3201 3296 IF ( ALLOCATED( surf_usm_h%qcsws ) ) & 3202 3297 surf_h(0)%qcsws(mm(0)) = surf_usm_h%qcsws(m) 3298 IF ( ALLOCATED( surf_usm_h%qisws ) ) & 3299 surf_h(0)%qisws(mm(0)) = surf_usm_h%qisws(m) 3203 3300 IF ( ALLOCATED( surf_usm_h%qrsws ) ) & 3204 3301 surf_h(0)%qrsws(mm(0)) = surf_usm_h%qrsws(m) … … 3207 3304 IF ( ALLOCATED( surf_usm_h%nrsws ) ) & 3208 3305 surf_h(0)%nrsws(mm(0)) = surf_usm_h%nrsws(m) 3306 IF ( ALLOCATED( surf_usm_h%nisws ) ) & 3307 surf_h(0)%nisws(mm(0)) = surf_usm_h%nisws(m) 3209 3308 IF ( ALLOCATED( surf_usm_h%sasws ) ) & 3210 3309 surf_h(0)%sasws(mm(0)) = surf_usm_h%sasws(m) 3211 3310 3212 3311 mm(0) = mm(0) + 1 3213 3312 3214 3313 ENDDO 3215 3314 … … 3222 3321 ! 3223 3322 !-- Recalculate start- and end indices for gathered surface type. 3224 start_index_h(l) = 1 3323 start_index_h(l) = 1 3225 3324 DO i = nxl, nxr 3226 3325 DO j = nys, nyn … … 3252 3351 !-- Treat vertically orientated surface. Again, gather data from different 3253 3352 !-- surfaces types but identical orientation (e.g. northward-facing) onto 3254 !-- one surface type which is output afterwards. 3353 !-- one surface type which is output afterwards. 3255 3354 mm(0:3) = 1 3256 3355 DO l = 0, 3 … … 3271 3370 IF ( ALLOCATED( surf_def_v(l)%ncs ) ) & 3272 3371 surf_v(l)%ncs(mm(l)) = surf_def_v(l)%ncs(m) 3372 IF ( ALLOCATED( surf_def_v(l)%qis ) ) & 3373 surf_v(l)%qis(mm(l)) = surf_def_v(l)%qis(m) 3374 IF ( ALLOCATED( surf_def_v(l)%nis ) ) & 3375 surf_v(l)%nis(mm(l)) = surf_def_v(l)%nis(m) 3273 3376 IF ( ALLOCATED( surf_def_v(l)%qrs ) ) & 3274 3377 surf_v(l)%qrs(mm(l)) = surf_def_v(l)%qrs(m) … … 3291 3394 IF ( ALLOCATED( surf_def_v(l)%ssws ) ) & 3292 3395 surf_v(l)%ssws(mm(l)) = surf_def_v(l)%ssws(m) 3293 IF ( ALLOCATED( surf_def_v(l)%css ) ) THEN 3396 IF ( ALLOCATED( surf_def_v(l)%css ) ) THEN 3294 3397 DO lsp = 1, nvar 3295 3398 surf_v(l)%css(lsp,mm(l)) = surf_def_v(l)%css(lsp,m) 3296 3399 ENDDO 3297 3400 ENDIF 3298 IF ( ALLOCATED( surf_def_v(l)%cssws ) ) THEN 3401 IF ( ALLOCATED( surf_def_v(l)%cssws ) ) THEN 3299 3402 DO lsp = 1, nvar 3300 3403 surf_v(l)%cssws(lsp,mm(l)) = surf_def_v(l)%cssws(lsp,m) … … 3303 3406 IF ( ALLOCATED( surf_def_v(l)%qcsws ) ) & 3304 3407 surf_v(l)%qcsws(mm(l)) = surf_def_v(l)%qcsws(m) 3408 IF ( ALLOCATED( surf_def_v(l)%qisws ) ) & 3409 surf_v(l)%qisws(mm(l)) = surf_def_v(l)%qisws(m) 3305 3410 IF ( ALLOCATED( surf_def_v(l)%qrsws ) ) & 3306 3411 surf_v(l)%qrsws(mm(l)) = surf_def_v(l)%qrsws(m) 3307 3412 IF ( ALLOCATED( surf_def_v(l)%ncsws ) ) & 3308 3413 surf_v(l)%ncsws(mm(l)) = surf_def_v(l)%ncsws(m) 3414 IF ( ALLOCATED( surf_def_v(l)%nisws ) ) & 3415 surf_v(l)%nisws(mm(l)) = surf_def_v(l)%nisws(m) 3309 3416 IF ( ALLOCATED( surf_def_v(l)%nrsws ) ) & 3310 3417 surf_v(l)%nrsws(mm(l)) = surf_def_v(l)%nrsws(m) … … 3317 3424 IF ( ALLOCATED( surf_def_v(l)%mom_flux_tke) ) & 3318 3425 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_def_v(l)%mom_flux_tke(0:1,m) 3319 3426 3320 3427 mm(l) = mm(l) + 1 3321 3428 ENDDO … … 3335 3442 IF ( ALLOCATED( surf_lsm_v(l)%ncs ) ) & 3336 3443 surf_v(l)%ncs(mm(l)) = surf_lsm_v(l)%ncs(m) 3444 IF ( ALLOCATED( surf_lsm_v(l)%qis ) ) & 3445 surf_v(l)%qis(mm(l)) = surf_lsm_v(l)%qis(m) 3446 IF ( ALLOCATED( surf_lsm_v(l)%nis ) ) & 3447 surf_v(l)%nis(mm(l)) = surf_lsm_v(l)%nis(m) 3337 3448 IF ( ALLOCATED( surf_lsm_v(l)%qrs ) ) & 3338 3449 surf_v(l)%qrs(mm(l)) = surf_lsm_v(l)%qrs(m) … … 3359 3470 IF ( ALLOCATED( surf_lsm_v(l)%ssws ) ) & 3360 3471 surf_v(l)%ssws(mm(l)) = surf_lsm_v(l)%ssws(m) 3361 IF ( ALLOCATED( surf_lsm_v(l)%css ) ) THEN 3472 IF ( ALLOCATED( surf_lsm_v(l)%css ) ) THEN 3362 3473 DO lsp = 1, nvar 3363 3474 surf_v(l)%css(lsp,mm(l)) = surf_lsm_v(l)%css(lsp,m) 3364 3475 ENDDO 3365 3476 ENDIF 3366 IF ( ALLOCATED( surf_lsm_v(l)%cssws ) ) THEN 3477 IF ( ALLOCATED( surf_lsm_v(l)%cssws ) ) THEN 3367 3478 DO lsp = 1, nvar 3368 3479 surf_v(l)%cssws(lsp,mm(l)) = surf_lsm_v(l)%cssws(lsp,m) … … 3373 3484 IF ( ALLOCATED( surf_lsm_v(l)%qrsws ) ) & 3374 3485 surf_v(l)%qrsws(mm(l)) = surf_lsm_v(l)%qrsws(m) 3486 IF ( ALLOCATED( surf_lsm_v(l)%qisws ) ) & 3487 surf_v(l)%qisws(mm(l)) = surf_lsm_v(l)%qisws(m) 3375 3488 IF ( ALLOCATED( surf_lsm_v(l)%ncsws ) ) & 3376 3489 surf_v(l)%ncsws(mm(l)) = surf_lsm_v(l)%ncsws(m) 3490 IF ( ALLOCATED( surf_lsm_v(l)%nisws ) ) & 3491 surf_v(l)%nisws(mm(l)) = surf_lsm_v(l)%nisws(m) 3377 3492 IF ( ALLOCATED( surf_lsm_v(l)%nrsws ) ) & 3378 3493 surf_v(l)%nrsws(mm(l)) = surf_lsm_v(l)%nrsws(m) … … 3385 3500 IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_tke) ) & 3386 3501 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_lsm_v(l)%mom_flux_tke(0:1,m) 3387 3502 3388 3503 mm(l) = mm(l) + 1 3389 3504 ENDDO … … 3403 3518 IF ( ALLOCATED( surf_usm_v(l)%ncs ) ) & 3404 3519 surf_v(l)%ncs(mm(l)) = surf_usm_v(l)%ncs(m) 3520 IF ( ALLOCATED( surf_usm_v(l)%qis ) ) & 3521 surf_v(l)%qis(mm(l)) = surf_usm_v(l)%qis(m) 3522 IF ( ALLOCATED( surf_usm_v(l)%nis ) ) & 3523 surf_v(l)%nis(mm(l)) = surf_usm_v(l)%nis(m) 3405 3524 IF ( ALLOCATED( surf_usm_v(l)%qrs ) ) & 3406 3525 surf_v(l)%qrs(mm(l)) = surf_usm_v(l)%qrs(m) … … 3427 3546 IF ( ALLOCATED( surf_usm_v(l)%ssws ) ) & 3428 3547 surf_v(l)%ssws(mm(l)) = surf_usm_v(l)%ssws(m) 3429 IF ( ALLOCATED( surf_usm_v(l)%css ) ) THEN 3548 IF ( ALLOCATED( surf_usm_v(l)%css ) ) THEN 3430 3549 DO lsp = 1, nvar 3431 3550 surf_v(l)%css(lsp,mm(l)) = surf_usm_v(l)%css(lsp,m) 3432 3551 ENDDO 3433 3552 ENDIF 3434 IF ( ALLOCATED( surf_usm_v(l)%cssws ) ) THEN 3553 IF ( ALLOCATED( surf_usm_v(l)%cssws ) ) THEN 3435 3554 DO lsp = 1, nvar 3436 3555 surf_v(l)%cssws(lsp,mm(l)) = surf_usm_v(l)%cssws(lsp,m) … … 3441 3560 IF ( ALLOCATED( surf_usm_v(l)%qrsws ) ) & 3442 3561 surf_v(l)%qrsws(mm(l)) = surf_usm_v(l)%qrsws(m) 3562 IF ( ALLOCATED( surf_usm_v(l)%qisws ) ) & 3563 surf_v(l)%qisws(mm(l)) = surf_usm_v(l)%qisws(m) 3443 3564 IF ( ALLOCATED( surf_usm_v(l)%ncsws ) ) & 3444 3565 surf_v(l)%ncsws(mm(l)) = surf_usm_v(l)%ncsws(m) 3566 IF ( ALLOCATED( surf_usm_v(l)%nisws ) ) & 3567 surf_v(l)%nisws(mm(l)) = surf_usm_v(l)%nisws(m) 3445 3568 IF ( ALLOCATED( surf_usm_v(l)%nrsws ) ) & 3446 3569 surf_v(l)%nrsws(mm(l)) = surf_usm_v(l)%nrsws(m) … … 3453 3576 IF ( ALLOCATED( surf_usm_v(l)%mom_flux_tke) ) & 3454 3577 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_usm_v(l)%mom_flux_tke(0:1,m) 3455 3578 3456 3579 mm(l) = mm(l) + 1 3457 3580 ENDDO 3458 3581 3459 3582 ENDDO 3460 3583 ENDDO … … 3544 3667 ENDIF 3545 3668 3669 IF ( ALLOCATED ( surf_h(l)%qis ) ) THEN 3670 CALL wrd_write_string( 'surf_h(' // dum // ')%qis' ) 3671 WRITE ( 14 ) surf_h(l)%qis 3672 ENDIF 3673 3674 IF ( ALLOCATED ( surf_h(l)%nis ) ) THEN 3675 CALL wrd_write_string( 'surf_h(' // dum // ')%nis' ) 3676 WRITE ( 14 ) surf_h(l)%nis 3677 ENDIF 3678 3546 3679 IF ( ALLOCATED ( surf_h(l)%qrs ) ) THEN 3547 3680 CALL wrd_write_string( 'surf_h(' // dum // ')%qrs' ) … … 3624 3757 ENDIF 3625 3758 3759 IF ( ALLOCATED ( surf_h(l)%qisws ) ) THEN 3760 CALL wrd_write_string( 'surf_h(' // dum // ')%qisws' ) 3761 WRITE ( 14 ) surf_h(l)%qisws 3762 ENDIF 3763 3764 IF ( ALLOCATED ( surf_h(l)%nisws ) ) THEN 3765 CALL wrd_write_string( 'surf_h(' // dum // ')%nisws' ) 3766 WRITE ( 14 ) surf_h(l)%nisws 3767 ENDIF 3768 3626 3769 IF ( ALLOCATED ( surf_h(l)%qrsws ) ) THEN 3627 3770 CALL wrd_write_string( 'surf_h(' // dum // ')%qrsws' ) … … 3671 3814 WRITE ( 14 ) surf_v(l)%ss 3672 3815 ENDIF 3673 3816 3674 3817 IF ( ALLOCATED ( surf_v(l)%qcs ) ) THEN 3675 3818 CALL wrd_write_string( 'surf_v(' // dum // ')%qcs' ) … … 3682 3825 ENDIF 3683 3826 3827 IF ( ALLOCATED ( surf_v(l)%qis ) ) THEN 3828 CALL wrd_write_string( 'surf_v(' // dum // ')%qis' ) 3829 WRITE ( 14 ) surf_v(l)%qis 3830 ENDIF 3831 3832 IF ( ALLOCATED ( surf_v(l)%nis ) ) THEN 3833 CALL wrd_write_string( 'surf_v(' // dum // ')%nis' ) 3834 WRITE ( 14 ) surf_v(l)%nis 3835 ENDIF 3836 3684 3837 IF ( ALLOCATED ( surf_v(l)%qrs ) ) THEN 3685 3838 CALL wrd_write_string( 'surf_v(' // dum // ')%qrs' ) … … 3706 3859 WRITE ( 14 ) surf_v(l)%pt_surface 3707 3860 ENDIF 3708 3861 3709 3862 IF ( ALLOCATED ( surf_v(l)%q_surface ) ) THEN 3710 3863 CALL wrd_write_string( 'surf_v(' // dum // ')%q_surface' ) … … 3750 3903 CALL wrd_write_string( 'surf_v(' // dum // ')%ncsws' ) 3751 3904 WRITE ( 14 ) surf_v(l)%ncsws 3905 ENDIF 3906 3907 IF ( ALLOCATED ( surf_v(l)%qisws ) ) THEN 3908 CALL wrd_write_string( 'surf_v(' // dum // ')%qisws' ) 3909 WRITE ( 14 ) surf_v(l)%qisws 3910 ENDIF 3911 3912 IF ( ALLOCATED ( surf_v(l)%nisws ) ) THEN 3913 CALL wrd_write_string( 'surf_v(' // dum // ')%nisws' ) 3914 WRITE ( 14 ) surf_v(l)%nisws 3752 3915 ENDIF 3753 3916 … … 3830 3993 ENDIF 3831 3994 3995 IF ( ALLOCATED ( surf_h(l)%qis ) ) THEN 3996 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qis', surf_h(l)%qis ) 3997 ENDIF 3998 3999 IF ( ALLOCATED ( surf_h(l)%nis ) ) THEN 4000 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nis', surf_h(l)%nis ) 4001 ENDIF 4002 3832 4003 IF ( ALLOCATED ( surf_h(l)%qrs ) ) THEN 3833 4004 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qrs', surf_h(l)%qrs ) … … 3892 4063 IF ( ALLOCATED ( surf_h(l)%ncsws ) ) THEN 3893 4064 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ncsws', surf_h(l)%ncsws ) 4065 ENDIF 4066 4067 IF ( ALLOCATED ( surf_h(l)%qisws ) ) THEN 4068 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qisws', surf_h(l)%qisws ) 4069 ENDIF 4070 4071 IF ( ALLOCATED ( surf_h(l)%nisws ) ) THEN 4072 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nisws', surf_h(l)%nisws ) 3894 4073 ENDIF 3895 4074 … … 3948 4127 ENDIF 3949 4128 4129 IF ( ALLOCATED ( surf_v(l)%qis ) ) THEN 4130 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qis', surf_v(l)%qis ) 4131 ENDIF 4132 4133 IF ( ALLOCATED ( surf_v(l)%nis ) ) THEN 4134 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nis', surf_v(l)%nis ) 4135 ENDIF 4136 3950 4137 IF ( ALLOCATED ( surf_v(l)%qrs ) ) THEN 3951 4138 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qrs', surf_v(l)%qrs ) … … 4002 4189 IF ( ALLOCATED ( surf_v(l)%ncsws ) ) THEN 4003 4190 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ncsws', surf_v(l)%ncsws ) 4191 ENDIF 4192 4193 IF ( ALLOCATED ( surf_v(l)%qisws ) ) THEN 4194 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qisws', surf_v(l)%qisws ) 4195 ENDIF 4196 4197 IF ( ALLOCATED ( surf_v(l)%nisws ) ) THEN 4198 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nisws', surf_v(l)%nisws ) 4004 4199 ENDIF 4005 4200 … … 4042 4237 ! ------------ 4043 4238 !> Reads surface-related restart data. Please note, restart data for a certain 4044 !> surface orientation (e.g. horizontal upward-facing) is stored in one 4045 !> array, even if surface elements may belong to different surface types 4239 !> surface orientation (e.g. horizontal upward-facing) is stored in one 4240 !> array, even if surface elements may belong to different surface types 4046 4241 !> natural or urban for example). Surface elements are redistributed into its 4047 !> respective surface types within this routine. This allows e.g. changing the 4048 !> surface type after reading the restart data, which might be required in case 4049 !> of cyclic_fill mode. 4242 !> respective surface types within this routine. This allows e.g. changing the 4243 !> surface type after reading the restart data, which might be required in case 4244 !> of cyclic_fill mode. 4050 4245 !------------------------------------------------------------------------------! 4051 4246 SUBROUTINE surface_rrd_local( kk, nxlf, nxlc, nxl_on_file, nxrf, & … … 4064 4259 INTEGER(iwp) :: kk !< running index over previous input files covering current local domain 4065 4260 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 4066 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 4067 INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain 4261 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 4262 INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain 4068 4263 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 4069 INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain 4264 INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain 4070 4265 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 4071 INTEGER(iwp) :: nyn_on_file !< index of norht boundary on former local domain 4072 INTEGER(iwp) :: nysc !< index of south boundary on current subdomain 4266 INTEGER(iwp) :: nyn_on_file !< index of norht boundary on former local domain 4267 INTEGER(iwp) :: nysc !< index of south boundary on current subdomain 4073 4268 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 4074 INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain 4269 INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain 4075 4270 4076 4271 INTEGER(iwp), SAVE :: l !< index variable for surface type … … 4093 4288 SELECT CASE ( restart_string(1:length) ) 4094 4289 ! 4095 !-- Read the number of horizontally orientated surface elements and 4290 !-- Read the number of horizontally orientated surface elements and 4096 4291 !-- allocate arrays 4097 4292 CASE ( 'ns_h_on_file' ) … … 4100 4295 4101 4296 IF ( ALLOCATED( surf_h(0)%start_index ) ) & 4102 CALL deallocate_surface_attributes_h( surf_h(0) ) 4297 CALL deallocate_surface_attributes_h( surf_h(0) ) 4103 4298 IF ( ALLOCATED( surf_h(1)%start_index ) ) & 4104 CALL deallocate_surface_attributes_h( surf_h(1) ) 4299 CALL deallocate_surface_attributes_h( surf_h(1) ) 4105 4300 IF ( ALLOCATED( surf_h(2)%start_index ) ) & 4106 CALL deallocate_surface_attributes_h_top( surf_h(2) ) 4107 ! 4108 !-- Allocate memory for number of surface elements on file. 4109 !-- Please note, these number is not necessarily the same as 4301 CALL deallocate_surface_attributes_h_top( surf_h(2) ) 4302 ! 4303 !-- Allocate memory for number of surface elements on file. 4304 !-- Please note, these number is not necessarily the same as 4110 4305 !-- the final number of surface elements on local domain, 4111 4306 !-- which is the case if processor topology changes during 4112 !-- restart runs. 4307 !-- restart runs. 4113 4308 !-- Horizontal upward facing 4114 4309 surf_h(0)%ns = ns_h_on_file(0) … … 4131 4326 ! 4132 4327 !-- Initial setting of flags for horizontal and vertical surfaces, 4133 !-- will be set after start- and end-indices are read. 4328 !-- will be set after start- and end-indices are read. 4134 4329 horizontal_surface = .FALSE. 4135 4330 vertical_surface = .FALSE. 4136 4331 4137 ENDIF 4138 ! 4139 !-- Read the number of vertically orientated surface elements and 4332 ENDIF 4333 ! 4334 !-- Read the number of vertically orientated surface elements and 4140 4335 !-- allocate arrays 4141 4336 CASE ( 'ns_v_on_file' ) … … 4162 4357 READ ( 13 ) surf_h(0)%start_index 4163 4358 l = 0 4164 CASE ( 'surf_h(0)%end_index' ) 4359 CASE ( 'surf_h(0)%end_index' ) 4165 4360 IF ( kk == 1 ) & 4166 4361 READ ( 13 ) surf_h(0)%end_index … … 4169 4364 ! 4170 4365 !-- Read specific attributes 4171 CASE ( 'surf_h(0)%us' ) 4366 CASE ( 'surf_h(0)%us' ) 4172 4367 IF ( ALLOCATED( surf_h(0)%us ) .AND. kk == 1 ) & 4173 4368 READ ( 13 ) surf_h(0)%us 4174 CASE ( 'surf_h(0)%ts' ) 4369 CASE ( 'surf_h(0)%ts' ) 4175 4370 IF ( ALLOCATED( surf_h(0)%ts ) .AND. kk == 1 ) & 4176 4371 READ ( 13 ) surf_h(0)%ts 4177 CASE ( 'surf_h(0)%qs' ) 4372 CASE ( 'surf_h(0)%qs' ) 4178 4373 IF ( ALLOCATED( surf_h(0)%qs ) .AND. kk == 1 ) & 4179 4374 READ ( 13 ) surf_h(0)%qs 4180 CASE ( 'surf_h(0)%ss' ) 4375 CASE ( 'surf_h(0)%ss' ) 4181 4376 IF ( ALLOCATED( surf_h(0)%ss ) .AND. kk == 1 ) & 4182 4377 READ ( 13 ) surf_h(0)%ss 4183 CASE ( 'surf_h(0)%qcs' ) 4378 CASE ( 'surf_h(0)%qcs' ) 4184 4379 IF ( ALLOCATED( surf_h(0)%qcs ) .AND. kk == 1 ) & 4185 4380 READ ( 13 ) surf_h(0)%qcs 4186 CASE ( 'surf_h(0)%ncs' ) 4381 CASE ( 'surf_h(0)%ncs' ) 4187 4382 IF ( ALLOCATED( surf_h(0)%ncs ) .AND. kk == 1 ) & 4188 4383 READ ( 13 ) surf_h(0)%ncs 4189 CASE ( 'surf_h(0)%qrs' ) 4384 CASE ( 'surf_h(0)%qis' ) 4385 IF ( ALLOCATED( surf_h(0)%qis ) .AND. kk == 1 ) & 4386 READ ( 13 ) surf_h(0)%qis 4387 CASE ( 'surf_h(0)%nis' ) 4388 IF ( ALLOCATED( surf_h(0)%nis ) .AND. kk == 1 ) & 4389 READ ( 13 ) surf_h(0)%nis 4390 CASE ( 'surf_h(0)%qrs' ) 4190 4391 IF ( ALLOCATED( surf_h(0)%qrs ) .AND. kk == 1 ) & 4191 4392 READ ( 13 ) surf_h(0)%qrs 4192 CASE ( 'surf_h(0)%nrs' ) 4393 CASE ( 'surf_h(0)%nrs' ) 4193 4394 IF ( ALLOCATED( surf_h(0)%nrs ) .AND. kk == 1 ) & 4194 4395 READ ( 13 ) surf_h(0)%nrs 4195 CASE ( 'surf_h(0)%ol' ) 4396 CASE ( 'surf_h(0)%ol' ) 4196 4397 IF ( ALLOCATED( surf_h(0)%ol ) .AND. kk == 1 ) & 4197 4398 READ ( 13 ) surf_h(0)%ol 4198 CASE ( 'surf_h(0)%rib' ) 4399 CASE ( 'surf_h(0)%rib' ) 4199 4400 IF ( ALLOCATED( surf_h(0)%rib ) .AND. kk == 1 ) & 4200 4401 READ ( 13 ) surf_h(0)%rib 4201 CASE ( 'surf_h(0)%pt_surface' ) 4402 CASE ( 'surf_h(0)%pt_surface' ) 4202 4403 IF ( ALLOCATED( surf_h(0)%pt_surface ) .AND. kk == 1 ) & 4203 4404 READ ( 13 ) surf_h(0)%pt_surface 4204 CASE ( 'surf_h(0)%q_surface' ) 4405 CASE ( 'surf_h(0)%q_surface' ) 4205 4406 IF ( ALLOCATED( surf_h(0)%q_surface ) .AND. kk == 1 ) & 4206 4407 READ ( 13 ) surf_h(0)%q_surface 4207 CASE ( 'surf_h(0)%vpt_surface' ) 4408 CASE ( 'surf_h(0)%vpt_surface' ) 4208 4409 IF ( ALLOCATED( surf_h(0)%vpt_surface ) .AND. kk == 1 ) & 4209 4410 READ ( 13 ) surf_h(0)%vpt_surface 4210 CASE ( 'surf_h(0)%usws' ) 4411 CASE ( 'surf_h(0)%usws' ) 4211 4412 IF ( ALLOCATED( surf_h(0)%usws ) .AND. kk == 1 ) & 4212 4413 READ ( 13 ) surf_h(0)%usws 4213 CASE ( 'surf_h(0)%vsws' ) 4414 CASE ( 'surf_h(0)%vsws' ) 4214 4415 IF ( ALLOCATED( surf_h(0)%vsws ) .AND. kk == 1 ) & 4215 4416 READ ( 13 ) surf_h(0)%vsws 4216 CASE ( 'surf_h(0)%shf' ) 4417 CASE ( 'surf_h(0)%shf' ) 4217 4418 IF ( ALLOCATED( surf_h(0)%shf ) .AND. kk == 1 ) & 4218 4419 READ ( 13 ) surf_h(0)%shf 4219 CASE ( 'surf_h(0)%qsws' ) 4420 CASE ( 'surf_h(0)%qsws' ) 4220 4421 IF ( ALLOCATED( surf_h(0)%qsws ) .AND. kk == 1 ) & 4221 4422 READ ( 13 ) surf_h(0)%qsws 4222 CASE ( 'surf_h(0)%ssws' ) 4423 CASE ( 'surf_h(0)%ssws' ) 4223 4424 IF ( ALLOCATED( surf_h(0)%ssws ) .AND. kk == 1 ) & 4224 4425 READ ( 13 ) surf_h(0)%ssws … … 4226 4427 IF ( ALLOCATED( surf_h(0)%css ) .AND. kk == 1 ) & 4227 4428 READ ( 13 ) surf_h(0)%css 4228 CASE ( 'surf_h(0)%cssws' ) 4429 CASE ( 'surf_h(0)%cssws' ) 4229 4430 IF ( ALLOCATED( surf_h(0)%cssws ) .AND. kk == 1 ) & 4230 4431 READ ( 13 ) surf_h(0)%cssws 4231 CASE ( 'surf_h(0)%qcsws' ) 4432 CASE ( 'surf_h(0)%qcsws' ) 4232 4433 IF ( ALLOCATED( surf_h(0)%qcsws ) .AND. kk == 1 ) & 4233 4434 READ ( 13 ) surf_h(0)%qcsws 4234 CASE ( 'surf_h(0)%ncsws' ) 4435 CASE ( 'surf_h(0)%ncsws' ) 4235 4436 IF ( ALLOCATED( surf_h(0)%ncsws ) .AND. kk == 1 ) & 4236 4437 READ ( 13 ) surf_h(0)%ncsws 4237 CASE ( 'surf_h(0)%qrsws' ) 4438 CASE ( 'surf_h(0)%qisws' ) 4439 IF ( ALLOCATED( surf_h(0)%qisws ) .AND. kk == 1 ) & 4440 READ ( 13 ) surf_h(0)%qisws 4441 CASE ( 'surf_h(0)%nisws' ) 4442 IF ( ALLOCATED( surf_h(0)%nisws ) .AND. kk == 1 ) & 4443 READ ( 13 ) surf_h(0)%nisws 4444 CASE ( 'surf_h(0)%qrsws' ) 4238 4445 IF ( ALLOCATED( surf_h(0)%qrsws ) .AND. kk == 1 ) & 4239 4446 READ ( 13 ) surf_h(0)%qrsws 4240 CASE ( 'surf_h(0)%nrsws' ) 4447 CASE ( 'surf_h(0)%nrsws' ) 4241 4448 IF ( ALLOCATED( surf_h(0)%nrsws ) .AND. kk == 1 ) & 4242 4449 READ ( 13 ) surf_h(0)%nrsws 4243 CASE ( 'surf_h(0)%sasws' ) 4450 CASE ( 'surf_h(0)%sasws' ) 4244 4451 IF ( ALLOCATED( surf_h(0)%sasws ) .AND. kk == 1 ) & 4245 4452 READ ( 13 ) surf_h(0)%sasws 4246 4453 4247 CASE ( 'surf_h(1)%start_index' ) 4454 CASE ( 'surf_h(1)%start_index' ) 4248 4455 IF ( kk == 1 ) & 4249 4456 READ ( 13 ) surf_h(1)%start_index 4250 4457 l = 1 4251 CASE ( 'surf_h(1)%end_index' ) 4458 CASE ( 'surf_h(1)%end_index' ) 4252 4459 IF ( kk == 1 ) & 4253 4460 READ ( 13 ) surf_h(1)%end_index 4254 CASE ( 'surf_h(1)%us' ) 4461 CASE ( 'surf_h(1)%us' ) 4255 4462 IF ( ALLOCATED( surf_h(1)%us ) .AND. kk == 1 ) & 4256 4463 READ ( 13 ) surf_h(1)%us 4257 CASE ( 'surf_h(1)%ts' ) 4464 CASE ( 'surf_h(1)%ts' ) 4258 4465 IF ( ALLOCATED( surf_h(1)%ts ) .AND. kk == 1 ) & 4259 4466 READ ( 13 ) surf_h(1)%ts 4260 CASE ( 'surf_h(1)%qs' ) 4467 CASE ( 'surf_h(1)%qs' ) 4261 4468 IF ( ALLOCATED( surf_h(1)%qs ) .AND. kk == 1 ) & 4262 4469 READ ( 13 ) surf_h(1)%qs 4263 CASE ( 'surf_h(1)%ss' ) 4470 CASE ( 'surf_h(1)%ss' ) 4264 4471 IF ( ALLOCATED( surf_h(1)%ss ) .AND. kk == 1 ) & 4265 4472 READ ( 13 ) surf_h(1)%ss 4266 CASE ( 'surf_h(1)%qcs' ) 4473 CASE ( 'surf_h(1)%qcs' ) 4267 4474 IF ( ALLOCATED( surf_h(1)%qcs ) .AND. kk == 1 ) & 4268 4475 READ ( 13 ) surf_h(1)%qcs 4269 CASE ( 'surf_h(1)%ncs' ) 4476 CASE ( 'surf_h(1)%ncs' ) 4270 4477 IF ( ALLOCATED( surf_h(1)%ncs ) .AND. kk == 1 ) & 4271 4478 READ ( 13 ) surf_h(1)%ncs 4272 CASE ( 'surf_h(1)%qrs' ) 4479 CASE ( 'surf_h(1)%qis' ) 4480 IF ( ALLOCATED( surf_h(1)%qis ) .AND. kk == 1 ) & 4481 READ ( 13 ) surf_h(1)%qis 4482 CASE ( 'surf_h(1)%nis' ) 4483 IF ( ALLOCATED( surf_h(1)%nis ) .AND. kk == 1 ) & 4484 READ ( 13 ) surf_h(1)%nis 4485 CASE ( 'surf_h(1)%qrs' ) 4273 4486 IF ( ALLOCATED( surf_h(1)%qrs ) .AND. kk == 1 ) & 4274 4487 READ ( 13 ) surf_h(1)%qrs 4275 CASE ( 'surf_h(1)%nrs' ) 4488 CASE ( 'surf_h(1)%nrs' ) 4276 4489 IF ( ALLOCATED( surf_h(1)%nrs ) .AND. kk == 1 ) & 4277 4490 READ ( 13 ) surf_h(1)%nrs 4278 CASE ( 'surf_h(1)%ol' ) 4491 CASE ( 'surf_h(1)%ol' ) 4279 4492 IF ( ALLOCATED( surf_h(1)%ol ) .AND. kk == 1 ) & 4280 4493 READ ( 13 ) surf_h(1)%ol 4281 CASE ( 'surf_h(1)%rib' ) 4494 CASE ( 'surf_h(1)%rib' ) 4282 4495 IF ( ALLOCATED( surf_h(1)%rib ) .AND. kk == 1 ) & 4283 4496 READ ( 13 ) surf_h(1)%rib 4284 CASE ( 'surf_h(1)%pt_surface' ) 4497 CASE ( 'surf_h(1)%pt_surface' ) 4285 4498 IF ( ALLOCATED( surf_h(1)%pt_surface ) .AND. kk == 1 ) & 4286 4499 READ ( 13 ) surf_h(1)%pt_surface 4287 CASE ( 'surf_h(1)%q_surface' ) 4500 CASE ( 'surf_h(1)%q_surface' ) 4288 4501 IF ( ALLOCATED( surf_h(1)%q_surface ) .AND. kk == 1 ) & 4289 4502 READ ( 13 ) surf_h(1)%q_surface 4290 CASE ( 'surf_h(1)%vpt_surface' ) 4503 CASE ( 'surf_h(1)%vpt_surface' ) 4291 4504 IF ( ALLOCATED( surf_h(1)%vpt_surface ) .AND. kk == 1 ) & 4292 4505 READ ( 13 ) surf_h(1)%vpt_surface 4293 CASE ( 'surf_h(1)%usws' ) 4506 CASE ( 'surf_h(1)%usws' ) 4294 4507 IF ( ALLOCATED( surf_h(1)%usws ) .AND. kk == 1 ) & 4295 4508 READ ( 13 ) surf_h(1)%usws 4296 CASE ( 'surf_h(1)%vsws' ) 4509 CASE ( 'surf_h(1)%vsws' ) 4297 4510 IF ( ALLOCATED( surf_h(1)%vsws ) .AND. kk == 1 ) & 4298 4511 READ ( 13 ) surf_h(1)%vsws 4299 CASE ( 'surf_h(1)%shf' ) 4512 CASE ( 'surf_h(1)%shf' ) 4300 4513 IF ( ALLOCATED( surf_h(1)%shf ) .AND. kk == 1 ) & 4301 4514 READ ( 13 ) surf_h(1)%shf 4302 CASE ( 'surf_h(1)%qsws' ) 4515 CASE ( 'surf_h(1)%qsws' ) 4303 4516 IF ( ALLOCATED( surf_h(1)%qsws ) .AND. kk == 1 ) & 4304 4517 READ ( 13 ) surf_h(1)%qsws 4305 CASE ( 'surf_h(1)%ssws' ) 4518 CASE ( 'surf_h(1)%ssws' ) 4306 4519 IF ( ALLOCATED( surf_h(1)%ssws ) .AND. kk == 1 ) & 4307 4520 READ ( 13 ) surf_h(1)%ssws … … 4309 4522 IF ( ALLOCATED( surf_h(1)%css ) .AND. kk == 1 ) & 4310 4523 READ ( 13 ) surf_h(1)%css 4311 CASE ( 'surf_h(1)%cssws' ) 4524 CASE ( 'surf_h(1)%cssws' ) 4312 4525 IF ( ALLOCATED( surf_h(1)%cssws ) .AND. kk == 1 ) & 4313 4526 READ ( 13 ) surf_h(1)%cssws 4314 CASE ( 'surf_h(1)%qcsws' ) 4527 CASE ( 'surf_h(1)%qcsws' ) 4315 4528 IF ( ALLOCATED( surf_h(1)%qcsws ) .AND. kk == 1 ) & 4316 4529 READ ( 13 ) surf_h(1)%qcsws 4317 CASE ( 'surf_h(1)%ncsws' ) 4530 CASE ( 'surf_h(1)%ncsws' ) 4318 4531 IF ( ALLOCATED( surf_h(1)%ncsws ) .AND. kk == 1 ) & 4319 4532 READ ( 13 ) surf_h(1)%ncsws 4320 CASE ( 'surf_h(1)%qrsws' ) 4533 CASE ( 'surf_h(1)%qisws' ) 4534 IF ( ALLOCATED( surf_h(1)%qisws ) .AND. kk == 1 ) & 4535 READ ( 13 ) surf_h(1)%qisws 4536 CASE ( 'surf_h(1)%nisws' ) 4537 IF ( ALLOCATED( surf_h(1)%nisws ) .AND. kk == 1 ) & 4538 READ ( 13 ) surf_h(1)%nisws 4539 CASE ( 'surf_h(1)%qrsws' ) 4321 4540 IF ( ALLOCATED( surf_h(1)%qrsws ) .AND. kk == 1 ) & 4322 4541 READ ( 13 ) surf_h(1)%qrsws 4323 CASE ( 'surf_h(1)%nrsws' ) 4542 CASE ( 'surf_h(1)%nrsws' ) 4324 4543 IF ( ALLOCATED( surf_h(1)%nrsws ) .AND. kk == 1 ) & 4325 4544 READ ( 13 ) surf_h(1)%nrsws 4326 CASE ( 'surf_h(1)%sasws' ) 4545 CASE ( 'surf_h(1)%sasws' ) 4327 4546 IF ( ALLOCATED( surf_h(1)%sasws ) .AND. kk == 1 ) & 4328 4547 READ ( 13 ) surf_h(1)%sasws 4329 4548 4330 CASE ( 'surf_h(2)%start_index' ) 4549 CASE ( 'surf_h(2)%start_index' ) 4331 4550 IF ( kk == 1 ) & 4332 4551 READ ( 13 ) surf_h(2)%start_index 4333 4552 l = 2 4334 CASE ( 'surf_h(2)%end_index' ) 4553 CASE ( 'surf_h(2)%end_index' ) 4335 4554 IF ( kk == 1 ) & 4336 4555 READ ( 13 ) surf_h(2)%end_index 4337 CASE ( 'surf_h(2)%us' ) 4556 CASE ( 'surf_h(2)%us' ) 4338 4557 IF ( ALLOCATED( surf_h(2)%us ) .AND. kk == 1 ) & 4339 4558 READ ( 13 ) surf_h(2)%us 4340 CASE ( 'surf_h(2)%ts' ) 4559 CASE ( 'surf_h(2)%ts' ) 4341 4560 IF ( ALLOCATED( surf_h(2)%ts ) .AND. kk == 1 ) & 4342 4561 READ ( 13 ) surf_h(2)%ts 4343 CASE ( 'surf_h(2)%qs' ) 4562 CASE ( 'surf_h(2)%qs' ) 4344 4563 IF ( ALLOCATED( surf_h(2)%qs ) .AND. kk == 1 ) & 4345 4564 READ ( 13 ) surf_h(2)%qs 4346 CASE ( 'surf_h(2)%ss' ) 4565 CASE ( 'surf_h(2)%ss' ) 4347 4566 IF ( ALLOCATED( surf_h(2)%ss ) .AND. kk == 1 ) & 4348 4567 READ ( 13 ) surf_h(2)%ss 4349 CASE ( 'surf_h(2)%qcs' ) 4568 CASE ( 'surf_h(2)%qcs' ) 4350 4569 IF ( ALLOCATED( surf_h(2)%qcs ) .AND. kk == 1 ) & 4351 4570 READ ( 13 ) surf_h(2)%qcs 4352 CASE ( 'surf_h(2)%ncs' ) 4571 CASE ( 'surf_h(2)%ncs' ) 4353 4572 IF ( ALLOCATED( surf_h(2)%ncs ) .AND. kk == 1 ) & 4354 4573 READ ( 13 ) surf_h(2)%ncs 4355 CASE ( 'surf_h(2)%qrs' ) 4574 CASE ( 'surf_h(2)%qis' ) 4575 IF ( ALLOCATED( surf_h(2)%qis ) .AND. kk == 1 ) & 4576 READ ( 13 ) surf_h(2)%qis 4577 CASE ( 'surf_h(2)%nis' ) 4578 IF ( ALLOCATED( surf_h(2)%nis ) .AND. kk == 1 ) & 4579 READ ( 13 ) surf_h(2)%nis 4580 CASE ( 'surf_h(2)%qrs' ) 4356 4581 IF ( ALLOCATED( surf_h(2)%qrs ) .AND. kk == 1 ) & 4357 4582 READ ( 13 ) surf_h(2)%qrs 4358 CASE ( 'surf_h(2)%nrs' ) 4583 CASE ( 'surf_h(2)%nrs' ) 4359 4584 IF ( ALLOCATED( surf_h(2)%nrs ) .AND. kk == 1 ) & 4360 4585 READ ( 13 ) surf_h(2)%nrs 4361 CASE ( 'surf_h(2)%ol' ) 4586 CASE ( 'surf_h(2)%ol' ) 4362 4587 IF ( ALLOCATED( surf_h(2)%ol ) .AND. kk == 1 ) & 4363 4588 READ ( 13 ) surf_h(2)%ol 4364 CASE ( 'surf_h(2)%rib' ) 4589 CASE ( 'surf_h(2)%rib' ) 4365 4590 IF ( ALLOCATED( surf_h(2)%rib ) .AND. kk == 1 ) & 4366 4591 READ ( 13 ) surf_h(2)%rib 4367 CASE ( 'surf_h(2)%pt_surface' ) 4592 CASE ( 'surf_h(2)%pt_surface' ) 4368 4593 IF ( ALLOCATED( surf_h(2)%pt_surface ) .AND. kk == 1 ) & 4369 4594 READ ( 13 ) surf_h(2)%pt_surface 4370 CASE ( 'surf_h(2)%q_surface' ) 4595 CASE ( 'surf_h(2)%q_surface' ) 4371 4596 IF ( ALLOCATED( surf_h(2)%q_surface ) .AND. kk == 1 ) & 4372 4597 READ ( 13 ) surf_h(2)%q_surface 4373 CASE ( 'surf_h(2)%vpt_surface' ) 4598 CASE ( 'surf_h(2)%vpt_surface' ) 4374 4599 IF ( ALLOCATED( surf_h(2)%vpt_surface ) .AND. kk == 1 ) & 4375 4600 READ ( 13 ) surf_h(2)%vpt_surface 4376 CASE ( 'surf_h(2)%usws' ) 4601 CASE ( 'surf_h(2)%usws' ) 4377 4602 IF ( ALLOCATED( surf_h(2)%usws ) .AND. kk == 1 ) & 4378 4603 READ ( 13 ) surf_h(2)%usws 4379 CASE ( 'surf_h(2)%vsws' ) 4604 CASE ( 'surf_h(2)%vsws' ) 4380 4605 IF ( ALLOCATED( surf_h(2)%vsws ) .AND. kk == 1 ) & 4381 4606 READ ( 13 ) surf_h(2)%vsws 4382 CASE ( 'surf_h(2)%shf' ) 4607 CASE ( 'surf_h(2)%shf' ) 4383 4608 IF ( ALLOCATED( surf_h(2)%shf ) .AND. kk == 1 ) & 4384 4609 READ ( 13 ) surf_h(2)%shf 4385 CASE ( 'surf_h(2)%qsws' ) 4610 CASE ( 'surf_h(2)%qsws' ) 4386 4611 IF ( ALLOCATED( surf_h(2)%qsws ) .AND. kk == 1 ) & 4387 4612 READ ( 13 ) surf_h(2)%qsws 4388 CASE ( 'surf_h(2)%ssws' ) 4613 CASE ( 'surf_h(2)%ssws' ) 4389 4614 IF ( ALLOCATED( surf_h(2)%ssws ) .AND. kk == 1 ) & 4390 4615 READ ( 13 ) surf_h(2)%ssws … … 4392 4617 IF ( ALLOCATED( surf_h(2)%css ) .AND. kk == 1 ) & 4393 4618 READ ( 13 ) surf_h(2)%css 4394 CASE ( 'surf_h(2)%cssws' ) 4619 CASE ( 'surf_h(2)%cssws' ) 4395 4620 IF ( ALLOCATED( surf_h(2)%cssws ) .AND. kk == 1 ) & 4396 4621 READ ( 13 ) surf_h(2)%cssws 4397 CASE ( 'surf_h(2)%qcsws' ) 4622 CASE ( 'surf_h(2)%qcsws' ) 4398 4623 IF ( ALLOCATED( surf_h(2)%qcsws ) .AND. kk == 1 ) & 4399 4624 READ ( 13 ) surf_h(2)%qcsws 4400 CASE ( 'surf_h(2)%ncsws' ) 4625 CASE ( 'surf_h(2)%ncsws' ) 4401 4626 IF ( ALLOCATED( surf_h(2)%ncsws ) .AND. kk == 1 ) & 4402 4627 READ ( 13 ) surf_h(2)%ncsws 4403 CASE ( 'surf_h(2)%qrsws' ) 4628 CASE ( 'surf_h(2)%qisws' ) 4629 IF ( ALLOCATED( surf_h(2)%qisws ) .AND. kk == 1 ) & 4630 READ ( 13 ) surf_h(2)%qisws 4631 CASE ( 'surf_h(2)%nisws' ) 4632 IF ( ALLOCATED( surf_h(2)%nisws ) .AND. kk == 1 ) & 4633 READ ( 13 ) surf_h(2)%nisws 4634 CASE ( 'surf_h(2)%qrsws' ) 4404 4635 IF ( ALLOCATED( surf_h(2)%qrsws ) .AND. kk == 1 ) & 4405 4636 READ ( 13 ) surf_h(2)%qrsws 4406 CASE ( 'surf_h(2)%nrsws' ) 4637 CASE ( 'surf_h(2)%nrsws' ) 4407 4638 IF ( ALLOCATED( surf_h(2)%nrsws ) .AND. kk == 1 ) & 4408 4639 READ ( 13 ) surf_h(2)%nrsws 4409 CASE ( 'surf_h(2)%sasws' ) 4640 CASE ( 'surf_h(2)%sasws' ) 4410 4641 IF ( ALLOCATED( surf_h(2)%sasws ) .AND. kk == 1 ) & 4411 4642 READ ( 13 ) surf_h(2)%sasws 4412 4643 4413 CASE ( 'surf_v(0)%start_index' ) 4644 CASE ( 'surf_v(0)%start_index' ) 4414 4645 IF ( kk == 1 ) & 4415 4646 READ ( 13 ) surf_v(0)%start_index … … 4417 4648 horizontal_surface = .FALSE. 4418 4649 vertical_surface = .TRUE. 4419 CASE ( 'surf_v(0)%end_index' ) 4650 CASE ( 'surf_v(0)%end_index' ) 4420 4651 IF ( kk == 1 ) & 4421 4652 READ ( 13 ) surf_v(0)%end_index 4422 CASE ( 'surf_v(0)%us' ) 4653 CASE ( 'surf_v(0)%us' ) 4423 4654 IF ( ALLOCATED( surf_v(0)%us ) .AND. kk == 1 ) & 4424 4655 READ ( 13 ) surf_v(0)%us 4425 CASE ( 'surf_v(0)%ts' ) 4656 CASE ( 'surf_v(0)%ts' ) 4426 4657 IF ( ALLOCATED( surf_v(0)%ts ) .AND. kk == 1 ) & 4427 4658 READ ( 13 ) surf_v(0)%ts 4428 CASE ( 'surf_v(0)%qs' ) 4659 CASE ( 'surf_v(0)%qs' ) 4429 4660 IF ( ALLOCATED( surf_v(0)%qs ) .AND. kk == 1 ) & 4430 4661 READ ( 13 ) surf_v(0)%qs 4431 CASE ( 'surf_v(0)%ss' ) 4662 CASE ( 'surf_v(0)%ss' ) 4432 4663 IF ( ALLOCATED( surf_v(0)%ss ) .AND. kk == 1 ) & 4433 4664 READ ( 13 ) surf_v(0)%ss 4434 CASE ( 'surf_v(0)%qcs' ) 4665 CASE ( 'surf_v(0)%qcs' ) 4435 4666 IF ( ALLOCATED( surf_v(0)%qcs ) .AND. kk == 1 ) & 4436 4667 READ ( 13 ) surf_v(0)%qcs 4437 CASE ( 'surf_v(0)%ncs' ) 4668 CASE ( 'surf_v(0)%ncs' ) 4438 4669 IF ( ALLOCATED( surf_v(0)%ncs ) .AND. kk == 1 ) & 4439 4670 READ ( 13 ) surf_v(0)%ncs 4440 CASE ( 'surf_v(0)%qrs' ) 4671 CASE ( 'surf_v(0)%qis' ) 4672 IF ( ALLOCATED( surf_v(0)%qis ) .AND. kk == 1 ) & 4673 READ ( 13 ) surf_v(0)%qis 4674 CASE ( 'surf_v(0)%nis' ) 4675 IF ( ALLOCATED( surf_v(0)%nis ) .AND. kk == 1 ) & 4676 READ ( 13 ) surf_v(0)%nis 4677 CASE ( 'surf_v(0)%qrs' ) 4441 4678 IF ( ALLOCATED( surf_v(0)%qrs ) .AND. kk == 1 ) & 4442 4679 READ ( 13 ) surf_v(0)%qrs 4443 CASE ( 'surf_v(0)%nrs' ) 4680 CASE ( 'surf_v(0)%nrs' ) 4444 4681 IF ( ALLOCATED( surf_v(0)%nrs ) .AND. kk == 1 ) & 4445 4682 READ ( 13 ) surf_v(0)%nrs 4446 CASE ( 'surf_v(0)%ol' ) 4683 CASE ( 'surf_v(0)%ol' ) 4447 4684 IF ( ALLOCATED( surf_v(0)%ol ) .AND. kk == 1 ) & 4448 4685 READ ( 13 ) surf_v(0)%ol 4449 CASE ( 'surf_v(0)%rib' ) 4686 CASE ( 'surf_v(0)%rib' ) 4450 4687 IF ( ALLOCATED( surf_v(0)%rib ) .AND. kk == 1 ) & 4451 4688 READ ( 13 ) surf_v(0)%rib 4452 CASE ( 'surf_v(0)%pt_surface' ) 4689 CASE ( 'surf_v(0)%pt_surface' ) 4453 4690 IF ( ALLOCATED( surf_v(0)%pt_surface ) .AND. kk == 1 ) & 4454 4691 READ ( 13 ) surf_v(0)%pt_surface 4455 CASE ( 'surf_v(0)%q_surface' ) 4692 CASE ( 'surf_v(0)%q_surface' ) 4456 4693 IF ( ALLOCATED( surf_v(0)%q_surface ) .AND. kk == 1 ) & 4457 4694 READ ( 13 ) surf_v(0)%q_surface 4458 CASE ( 'surf_v(0)%vpt_surface' ) 4695 CASE ( 'surf_v(0)%vpt_surface' ) 4459 4696 IF ( ALLOCATED( surf_v(0)%vpt_surface ) .AND. kk == 1 ) & 4460 4697 READ ( 13 ) surf_v(0)%vpt_surface 4461 CASE ( 'surf_v(0)%shf' ) 4698 CASE ( 'surf_v(0)%shf' ) 4462 4699 IF ( ALLOCATED( surf_v(0)%shf ) .AND. kk == 1 ) & 4463 4700 READ ( 13 ) surf_v(0)%shf 4464 CASE ( 'surf_v(0)%qsws' ) 4701 CASE ( 'surf_v(0)%qsws' ) 4465 4702 IF ( ALLOCATED( surf_v(0)%qsws ) .AND. kk == 1 ) & 4466 4703 READ ( 13 ) surf_v(0)%qsws 4467 CASE ( 'surf_v(0)%ssws' ) 4704 CASE ( 'surf_v(0)%ssws' ) 4468 4705 IF ( ALLOCATED( surf_v(0)%ssws ) .AND. kk == 1 ) & 4469 4706 READ ( 13 ) surf_v(0)%ssws 4470 CASE ( 'surf_v(0)%css' ) 4707 CASE ( 'surf_v(0)%css' ) 4471 4708 IF ( ALLOCATED( surf_v(0)%css ) .AND. kk == 1 ) & 4472 4709 READ ( 13 ) surf_v(0)%css 4473 CASE ( 'surf_v(0)%cssws' ) 4710 CASE ( 'surf_v(0)%cssws' ) 4474 4711 IF ( ALLOCATED( surf_v(0)%cssws ) .AND. kk == 1 ) & 4475 4712 READ ( 13 ) surf_v(0)%cssws 4476 CASE ( 'surf_v(0)%qcsws' ) 4713 CASE ( 'surf_v(0)%qcsws' ) 4477 4714 IF ( ALLOCATED( surf_v(0)%qcsws ) .AND. kk == 1 ) & 4478 4715 READ ( 13 ) surf_v(0)%qcsws 4479 CASE ( 'surf_v(0)%ncsws' ) 4716 CASE ( 'surf_v(0)%ncsws' ) 4480 4717 IF ( ALLOCATED( surf_v(0)%ncsws ) .AND. kk == 1 ) & 4481 4718 READ ( 13 ) surf_v(0)%ncsws 4482 CASE ( 'surf_v(0)%qrsws' ) 4719 CASE ( 'surf_v(0)%qisws' ) 4720 IF ( ALLOCATED( surf_v(0)%qisws ) .AND. kk == 1 ) & 4721 READ ( 13 ) surf_v(0)%qisws 4722 CASE ( 'surf_v(0)%nisws' ) 4723 IF ( ALLOCATED( surf_v(0)%nisws ) .AND. kk == 1 ) & 4724 READ ( 13 ) surf_v(0)%nisws 4725 CASE ( 'surf_v(0)%qrsws' ) 4483 4726 IF ( ALLOCATED( surf_v(0)%qrsws ) .AND. kk == 1 ) & 4484 4727 READ ( 13 ) surf_v(0)%qrsws 4485 CASE ( 'surf_v(0)%nrsws' ) 4728 CASE ( 'surf_v(0)%nrsws' ) 4486 4729 IF ( ALLOCATED( surf_v(0)%nrsws ) .AND. kk == 1 ) & 4487 4730 READ ( 13 ) surf_v(0)%nrsws 4488 CASE ( 'surf_v(0)%sasws' ) 4731 CASE ( 'surf_v(0)%sasws' ) 4489 4732 IF ( ALLOCATED( surf_v(0)%sasws ) .AND. kk == 1 ) & 4490 4733 READ ( 13 ) surf_v(0)%sasws 4491 CASE ( 'surf_v(0)%mom_uv' ) 4734 CASE ( 'surf_v(0)%mom_uv' ) 4492 4735 IF ( ALLOCATED( surf_v(0)%mom_flux_uv ) .AND. kk == 1 ) & 4493 4736 READ ( 13 ) surf_v(0)%mom_flux_uv 4494 CASE ( 'surf_v(0)%mom_w' ) 4737 CASE ( 'surf_v(0)%mom_w' ) 4495 4738 IF ( ALLOCATED( surf_v(0)%mom_flux_w ) .AND. kk == 1 ) & 4496 4739 READ ( 13 ) surf_v(0)%mom_flux_w 4497 CASE ( 'surf_v(0)%mom_tke' ) 4740 CASE ( 'surf_v(0)%mom_tke' ) 4498 4741 IF ( ALLOCATED( surf_v(0)%mom_flux_tke ) .AND. kk == 1 ) & 4499 4742 READ ( 13 ) surf_v(0)%mom_flux_tke 4500 4743 4501 CASE ( 'surf_v(1)%start_index' ) 4744 CASE ( 'surf_v(1)%start_index' ) 4502 4745 IF ( kk == 1 ) & 4503 4746 READ ( 13 ) surf_v(1)%start_index 4504 4747 l = 1 4505 CASE ( 'surf_v(1)%end_index' ) 4748 CASE ( 'surf_v(1)%end_index' ) 4506 4749 IF ( kk == 1 ) & 4507 4750 READ ( 13 ) surf_v(1)%end_index 4508 CASE ( 'surf_v(1)%us' ) 4751 CASE ( 'surf_v(1)%us' ) 4509 4752 IF ( ALLOCATED( surf_v(1)%us ) .AND. kk == 1 ) & 4510 4753 READ ( 13 ) surf_v(1)%us 4511 CASE ( 'surf_v(1)%ts' ) 4754 CASE ( 'surf_v(1)%ts' ) 4512 4755 IF ( ALLOCATED( surf_v(1)%ts ) .AND. kk == 1 ) & 4513 4756 READ ( 13 ) surf_v(1)%ts 4514 CASE ( 'surf_v(1)%qs' ) 4757 CASE ( 'surf_v(1)%qs' ) 4515 4758 IF ( ALLOCATED( surf_v(1)%qs ) .AND. kk == 1 ) & 4516 4759 READ ( 13 ) surf_v(1)%qs 4517 CASE ( 'surf_v(1)%ss' ) 4760 CASE ( 'surf_v(1)%ss' ) 4518 4761 IF ( ALLOCATED( surf_v(1)%ss ) .AND. kk == 1 ) & 4519 4762 READ ( 13 ) surf_v(1)%ss 4520 CASE ( 'surf_v(1)%qcs' ) 4763 CASE ( 'surf_v(1)%qcs' ) 4521 4764 IF ( ALLOCATED( surf_v(1)%qcs ) .AND. kk == 1 ) & 4522 4765 READ ( 13 ) surf_v(1)%qcs 4523 CASE ( 'surf_v(1)%ncs' ) 4766 CASE ( 'surf_v(1)%ncs' ) 4524 4767 IF ( ALLOCATED( surf_v(1)%ncs ) .AND. kk == 1 ) & 4525 4768 READ ( 13 ) surf_v(1)%ncs 4526 CASE ( 'surf_v(1)%qrs' ) 4769 CASE ( 'surf_v(1)%qis' ) 4770 IF ( ALLOCATED( surf_v(1)%qis ) .AND. kk == 1 ) & 4771 READ ( 13 ) surf_v(1)%qis 4772 CASE ( 'surf_v(1)%nis' ) 4773 IF ( ALLOCATED( surf_v(1)%nis ) .AND. kk == 1 ) & 4774 READ ( 13 ) surf_v(1)%nis 4775 CASE ( 'surf_v(1)%qrs' ) 4527 4776 IF ( ALLOCATED( surf_v(1)%qrs ) .AND. kk == 1 ) & 4528 4777 READ ( 13 ) surf_v(1)%qrs 4529 CASE ( 'surf_v(1)%nrs' ) 4778 CASE ( 'surf_v(1)%nrs' ) 4530 4779 IF ( ALLOCATED( surf_v(1)%nrs ) .AND. kk == 1 ) & 4531 4780 READ ( 13 ) surf_v(1)%nrs 4532 CASE ( 'surf_v(1)%ol' ) 4781 CASE ( 'surf_v(1)%ol' ) 4533 4782 IF ( ALLOCATED( surf_v(1)%ol ) .AND. kk == 1 ) & 4534 4783 READ ( 13 ) surf_v(1)%ol 4535 CASE ( 'surf_v(1)%rib' ) 4784 CASE ( 'surf_v(1)%rib' ) 4536 4785 IF ( ALLOCATED( surf_v(1)%rib ) .AND. kk == 1 ) & 4537 4786 READ ( 13 ) surf_v(1)%rib 4538 CASE ( 'surf_v(1)%pt_surface' ) 4787 CASE ( 'surf_v(1)%pt_surface' ) 4539 4788 IF ( ALLOCATED( surf_v(1)%pt_surface ) .AND. kk == 1 ) & 4540 4789 READ ( 13 ) surf_v(1)%pt_surface 4541 CASE ( 'surf_v(1)%q_surface' ) 4790 CASE ( 'surf_v(1)%q_surface' ) 4542 4791 IF ( ALLOCATED( surf_v(1)%q_surface ) .AND. kk == 1 ) & 4543 4792 READ ( 13 ) surf_v(1)%q_surface 4544 CASE ( 'surf_v(1)%vpt_surface' ) 4793 CASE ( 'surf_v(1)%vpt_surface' ) 4545 4794 IF ( ALLOCATED( surf_v(1)%vpt_surface ) .AND. kk == 1 ) & 4546 4795 READ ( 13 ) surf_v(1)%vpt_surface 4547 CASE ( 'surf_v(1)%shf' ) 4796 CASE ( 'surf_v(1)%shf' ) 4548 4797 IF ( ALLOCATED( surf_v(1)%shf ) .AND. kk == 1 ) & 4549 4798 READ ( 13 ) surf_v(1)%shf 4550 CASE ( 'surf_v(1)%qsws' ) 4799 CASE ( 'surf_v(1)%qsws' ) 4551 4800 IF ( ALLOCATED( surf_v(1)%qsws ) .AND. kk == 1 ) & 4552 4801 READ ( 13 ) surf_v(1)%qsws 4553 CASE ( 'surf_v(1)%ssws' ) 4802 CASE ( 'surf_v(1)%ssws' ) 4554 4803 IF ( ALLOCATED( surf_v(1)%ssws ) .AND. kk == 1 ) & 4555 4804 READ ( 13 ) surf_v(1)%ssws 4556 CASE ( 'surf_v(1)%css' ) 4805 CASE ( 'surf_v(1)%css' ) 4557 4806 IF ( ALLOCATED( surf_v(1)%css ) .AND. kk == 1 ) & 4558 4807 READ ( 13 ) surf_v(1)%css 4559 CASE ( 'surf_v(1)%cssws' ) 4808 CASE ( 'surf_v(1)%cssws' ) 4560 4809 IF ( ALLOCATED( surf_v(1)%cssws ) .AND. kk == 1 ) & 4561 4810 READ ( 13 ) surf_v(1)%cssws 4562 CASE ( 'surf_v(1)%qcsws' ) 4811 CASE ( 'surf_v(1)%qcsws' ) 4563 4812 IF ( ALLOCATED( surf_v(1)%qcsws ) .AND. kk == 1 ) & 4564 4813 READ ( 13 ) surf_v(1)%qcsws 4565 CASE ( 'surf_v(1)%ncsws' ) 4814 CASE ( 'surf_v(1)%ncsws' ) 4566 4815 IF ( ALLOCATED( surf_v(1)%ncsws ) .AND. kk == 1 ) & 4567 4816 READ ( 13 ) surf_v(1)%ncsws 4568 CASE ( 'surf_v(1)%qrsws' ) 4817 CASE ( 'surf_v(1)%qisws' ) 4818 IF ( ALLOCATED( surf_v(1)%qisws ) .AND. kk == 1 ) & 4819 READ ( 13 ) surf_v(1)%qisws 4820 CASE ( 'surf_v(1)%nisws' ) 4821 IF ( ALLOCATED( surf_v(1)%nisws ) .AND. kk == 1 ) & 4822 READ ( 13 ) surf_v(1)%nisws 4823 CASE ( 'surf_v(1)%qrsws' ) 4569 4824 IF ( ALLOCATED( surf_v(1)%qrsws ) .AND. kk == 1 ) & 4570 4825 READ ( 13 ) surf_v(1)%qrsws 4571 CASE ( 'surf_v(1)%nrsws' ) 4826 CASE ( 'surf_v(1)%nrsws' ) 4572 4827 IF ( ALLOCATED( surf_v(1)%nrsws ) .AND. kk == 1 ) & 4573 4828 READ ( 13 ) surf_v(1)%nrsws 4574 CASE ( 'surf_v(1)%sasws' ) 4829 CASE ( 'surf_v(1)%sasws' ) 4575 4830 IF ( ALLOCATED( surf_v(1)%sasws ) .AND. kk == 1 ) & 4576 4831 READ ( 13 ) surf_v(1)%sasws 4577 CASE ( 'surf_v(1)%mom_uv' ) 4832 CASE ( 'surf_v(1)%mom_uv' ) 4578 4833 IF ( ALLOCATED( surf_v(1)%mom_flux_uv ) .AND. kk == 1 ) & 4579 4834 READ ( 13 ) surf_v(1)%mom_flux_uv 4580 CASE ( 'surf_v(1)%mom_w' ) 4835 CASE ( 'surf_v(1)%mom_w' ) 4581 4836 IF ( ALLOCATED( surf_v(1)%mom_flux_w ) .AND. kk == 1 ) & 4582 4837 READ ( 13 ) surf_v(1)%mom_flux_w 4583 CASE ( 'surf_v(1)%mom_tke' ) 4838 CASE ( 'surf_v(1)%mom_tke' ) 4584 4839 IF ( ALLOCATED( surf_v(1)%mom_flux_tke ) .AND. kk == 1 ) & 4585 4840 READ ( 13 ) surf_v(1)%mom_flux_tke 4586 4841 4587 CASE ( 'surf_v(2)%start_index' ) 4842 CASE ( 'surf_v(2)%start_index' ) 4588 4843 IF ( kk == 1 ) & 4589 4844 READ ( 13 ) surf_v(2)%start_index 4590 4845 l = 2 4591 CASE ( 'surf_v(2)%end_index' ) 4846 CASE ( 'surf_v(2)%end_index' ) 4592 4847 IF ( kk == 1 ) & 4593 4848 READ ( 13 ) surf_v(2)%end_index 4594 CASE ( 'surf_v(2)%us' ) 4849 CASE ( 'surf_v(2)%us' ) 4595 4850 IF ( ALLOCATED( surf_v(2)%us ) .AND. kk == 1 ) & 4596 4851 READ ( 13 ) surf_v(2)%us 4597 CASE ( 'surf_v(2)%ts' ) 4852 CASE ( 'surf_v(2)%ts' ) 4598 4853 IF ( ALLOCATED( surf_v(2)%ts ) .AND. kk == 1 ) & 4599 4854 READ ( 13 ) surf_v(2)%ts 4600 CASE ( 'surf_v(2)%qs' ) 4855 CASE ( 'surf_v(2)%qs' ) 4601 4856 IF ( ALLOCATED( surf_v(2)%qs ) .AND. kk == 1 ) & 4602 4857 READ ( 13 ) surf_v(2)%qs 4603 CASE ( 'surf_v(2)%ss' ) 4858 CASE ( 'surf_v(2)%ss' ) 4604 4859 IF ( ALLOCATED( surf_v(2)%ss ) .AND. kk == 1 ) & 4605 4860 READ ( 13 ) surf_v(2)%ss 4606 CASE ( 'surf_v(2)%qcs' ) 4861 CASE ( 'surf_v(2)%qcs' ) 4607 4862 IF ( ALLOCATED( surf_v(2)%qcs ) .AND. kk == 1 ) & 4608 4863 READ ( 13 ) surf_v(2)%qcs 4609 CASE ( 'surf_v(2)%ncs' ) 4864 CASE ( 'surf_v(2)%ncs' ) 4610 4865 IF ( ALLOCATED( surf_v(2)%ncs ) .AND. kk == 1 ) & 4611 4866 READ ( 13 ) surf_v(2)%ncs 4612 CASE ( 'surf_v(2)%qrs' ) 4867 CASE ( 'surf_v(2)%qis' ) 4868 IF ( ALLOCATED( surf_v(2)%qis ) .AND. kk == 1 ) & 4869 READ ( 13 ) surf_v(2)%qis 4870 CASE ( 'surf_v(2)%nis' ) 4871 IF ( ALLOCATED( surf_v(2)%nis ) .AND. kk == 1 ) & 4872 READ ( 13 ) surf_v(2)%nis 4873 CASE ( 'surf_v(2)%qrs' ) 4613 4874 IF ( ALLOCATED( surf_v(2)%qrs ) .AND. kk == 1 ) & 4614 4875 READ ( 13 ) surf_v(2)%qrs 4615 CASE ( 'surf_v(2)%nrs' ) 4876 CASE ( 'surf_v(2)%nrs' ) 4616 4877 IF ( ALLOCATED( surf_v(2)%nrs ) .AND. kk == 1 ) & 4617 4878 READ ( 13 ) surf_v(2)%nrs 4618 CASE ( 'surf_v(2)%ol' ) 4879 CASE ( 'surf_v(2)%ol' ) 4619 4880 IF ( ALLOCATED( surf_v(2)%ol ) .AND. kk == 1 ) & 4620 4881 READ ( 13 ) surf_v(2)%ol 4621 CASE ( 'surf_v(2)%rib' ) 4882 CASE ( 'surf_v(2)%rib' ) 4622 4883 IF ( ALLOCATED( surf_v(2)%rib ) .AND. kk == 1 ) & 4623 4884 READ ( 13 ) surf_v(2)%rib 4624 CASE ( 'surf_v(2)%pt_surface' ) 4885 CASE ( 'surf_v(2)%pt_surface' ) 4625 4886 IF ( ALLOCATED( surf_v(2)%pt_surface ) .AND. kk == 1 ) & 4626 4887 READ ( 13 ) surf_v(2)%pt_surface 4627 CASE ( 'surf_v(2)%q_surface' ) 4888 CASE ( 'surf_v(2)%q_surface' ) 4628 4889 IF ( ALLOCATED( surf_v(2)%q_surface ) .AND. kk == 1 ) & 4629 4890 READ ( 13 ) surf_v(2)%q_surface 4630 CASE ( 'surf_v(2)%vpt_surface' ) 4891 CASE ( 'surf_v(2)%vpt_surface' ) 4631 4892 IF ( ALLOCATED( surf_v(2)%vpt_surface ) .AND. kk == 1 ) & 4632 4893 READ ( 13 ) surf_v(2)%vpt_surface 4633 CASE ( 'surf_v(2)%shf' ) 4894 CASE ( 'surf_v(2)%shf' ) 4634 4895 IF ( ALLOCATED( surf_v(2)%shf ) .AND. kk == 1 ) & 4635 4896 READ ( 13 ) surf_v(2)%shf 4636 CASE ( 'surf_v(2)%qsws' ) 4897 CASE ( 'surf_v(2)%qsws' ) 4637 4898 IF ( ALLOCATED( surf_v(2)%qsws ) .AND. kk == 1 ) & 4638 4899 READ ( 13 ) surf_v(2)%qsws 4639 CASE ( 'surf_v(2)%ssws' ) 4900 CASE ( 'surf_v(2)%ssws' ) 4640 4901 IF ( ALLOCATED( surf_v(2)%ssws ) .AND. kk == 1 ) & 4641 4902 READ ( 13 ) surf_v(2)%ssws 4642 CASE ( 'surf_v(2)%css' ) 4903 CASE ( 'surf_v(2)%css' ) 4643 4904 IF ( ALLOCATED( surf_v(2)%css ) .AND. kk == 1 ) & 4644 4905 READ ( 13 ) surf_v(2)%css 4645 CASE ( 'surf_v(2)%cssws' ) 4906 CASE ( 'surf_v(2)%cssws' ) 4646 4907 IF ( ALLOCATED( surf_v(2)%cssws ) .AND. kk == 1 ) & 4647 4908 READ ( 13 ) surf_v(2)%cssws 4648 CASE ( 'surf_v(2)%qcsws' ) 4909 CASE ( 'surf_v(2)%qcsws' ) 4649 4910 IF ( ALLOCATED( surf_v(2)%qcsws ) .AND. kk == 1 ) & 4650 4911 READ ( 13 ) surf_v(2)%qcsws 4651 CASE ( 'surf_v(2)%ncsws' ) 4912 CASE ( 'surf_v(2)%ncsws' ) 4652 4913 IF ( ALLOCATED( surf_v(2)%ncsws ) .AND. kk == 1 ) & 4653 4914 READ ( 13 ) surf_v(2)%ncsws 4654 CASE ( 'surf_v(2)%qrsws' ) 4915 CASE ( 'surf_v(2)%qisws' ) 4916 IF ( ALLOCATED( surf_v(2)%qisws ) .AND. kk == 1 ) & 4917 READ ( 13 ) surf_v(2)%qisws 4918 CASE ( 'surf_v(2)%nisws' ) 4919 IF ( ALLOCATED( surf_v(2)%nisws ) .AND. kk == 1 ) & 4920 READ ( 13 ) surf_v(2)%nisws 4921 CASE ( 'surf_v(2)%qrsws' ) 4655 4922 IF ( ALLOCATED( surf_v(2)%qrsws ) .AND. kk == 1 ) & 4656 4923 READ ( 13 ) surf_v(2)%qrsws 4657 CASE ( 'surf_v(2)%nrsws' ) 4924 CASE ( 'surf_v(2)%nrsws' ) 4658 4925 IF ( ALLOCATED( surf_v(2)%nrsws ) .AND. kk == 1 ) & 4659 4926 READ ( 13 ) surf_v(2)%nrsws 4660 CASE ( 'surf_v(2)%sasws' ) 4927 CASE ( 'surf_v(2)%sasws' ) 4661 4928 IF ( ALLOCATED( surf_v(2)%sasws ) .AND. kk == 1 ) & 4662 4929 READ ( 13 ) surf_v(2)%sasws 4663 CASE ( 'surf_v(2)%mom_uv' ) 4930 CASE ( 'surf_v(2)%mom_uv' ) 4664 4931 IF ( ALLOCATED( surf_v(2)%mom_flux_uv ) .AND. kk == 1 ) & 4665 4932 READ ( 13 ) surf_v(2)%mom_flux_uv 4666 CASE ( 'surf_v(2)%mom_w' ) 4933 CASE ( 'surf_v(2)%mom_w' ) 4667 4934 IF ( ALLOCATED( surf_v(2)%mom_flux_w ) .AND. kk == 1 ) & 4668 4935 READ ( 13 ) surf_v(2)%mom_flux_w 4669 CASE ( 'surf_v(2)%mom_tke' ) 4936 CASE ( 'surf_v(2)%mom_tke' ) 4670 4937 IF ( ALLOCATED( surf_v(2)%mom_flux_tke ) .AND. kk == 1 ) & 4671 4938 READ ( 13 ) surf_v(2)%mom_flux_tke 4672 4939 4673 CASE ( 'surf_v(3)%start_index' ) 4940 CASE ( 'surf_v(3)%start_index' ) 4674 4941 IF ( kk == 1 ) & 4675 4942 READ ( 13 ) surf_v(3)%start_index 4676 4943 l = 3 4677 CASE ( 'surf_v(3)%end_index' ) 4944 CASE ( 'surf_v(3)%end_index' ) 4678 4945 IF ( kk == 1 ) & 4679 4946 READ ( 13 ) surf_v(3)%end_index 4680 CASE ( 'surf_v(3)%us' ) 4947 CASE ( 'surf_v(3)%us' ) 4681 4948 IF ( ALLOCATED( surf_v(3)%us ) .AND. kk == 1 ) & 4682 4949 READ ( 13 ) surf_v(3)%us 4683 CASE ( 'surf_v(3)%ts' ) 4950 CASE ( 'surf_v(3)%ts' ) 4684 4951 IF ( ALLOCATED( surf_v(3)%ts ) .AND. kk == 1 ) & 4685 4952 READ ( 13 ) surf_v(3)%ts 4686 CASE ( 'surf_v(3)%qs' ) 4953 CASE ( 'surf_v(3)%qs' ) 4687 4954 IF ( ALLOCATED( surf_v(3)%qs ) .AND. kk == 1 ) & 4688 4955 READ ( 13 ) surf_v(3)%qs 4689 CASE ( 'surf_v(3)%ss' ) 4956 CASE ( 'surf_v(3)%ss' ) 4690 4957 IF ( ALLOCATED( surf_v(3)%ss ) .AND. kk == 1 ) & 4691 4958 READ ( 13 ) surf_v(3)%ss 4692 CASE ( 'surf_v(3)%qcs' ) 4959 CASE ( 'surf_v(3)%qcs' ) 4693 4960 IF ( ALLOCATED( surf_v(3)%qcs ) .AND. kk == 1 ) & 4694 4961 READ ( 13 ) surf_v(3)%qcs 4695 CASE ( 'surf_v(3)%ncs' ) 4962 CASE ( 'surf_v(3)%ncs' ) 4696 4963 IF ( ALLOCATED( surf_v(3)%ncs ) .AND. kk == 1 ) & 4697 4964 READ ( 13 ) surf_v(3)%ncs 4698 CASE ( 'surf_v(3)%qrs' ) 4965 CASE ( 'surf_v(3)%qis' ) 4966 IF ( ALLOCATED( surf_v(3)%qis ) .AND. kk == 1 ) & 4967 READ ( 13 ) surf_v(3)%qis 4968 CASE ( 'surf_v(3)%nis' ) 4969 IF ( ALLOCATED( surf_v(3)%nis ) .AND. kk == 1 ) & 4970 READ ( 13 ) surf_v(3)%nis 4971 CASE ( 'surf_v(3)%qrs' ) 4699 4972 IF ( ALLOCATED( surf_v(3)%qrs ) .AND. kk == 1 ) & 4700 4973 READ ( 13 ) surf_v(3)%qrs 4701 CASE ( 'surf_v(3)%nrs' ) 4974 CASE ( 'surf_v(3)%nrs' ) 4702 4975 IF ( ALLOCATED( surf_v(3)%nrs ) .AND. kk == 1 ) & 4703 4976 READ ( 13 ) surf_v(3)%nrs 4704 CASE ( 'surf_v(3)%ol' ) 4977 CASE ( 'surf_v(3)%ol' ) 4705 4978 IF ( ALLOCATED( surf_v(3)%ol ) .AND. kk == 1 ) & 4706 4979 READ ( 13 ) surf_v(3)%ol 4707 CASE ( 'surf_v(3)%rib' ) 4980 CASE ( 'surf_v(3)%rib' ) 4708 4981 IF ( ALLOCATED( surf_v(3)%rib ) .AND. kk == 1 ) & 4709 4982 READ ( 13 ) surf_v(3)%rib 4710 CASE ( 'surf_v(3)%pt_surface' ) 4983 CASE ( 'surf_v(3)%pt_surface' ) 4711 4984 IF ( ALLOCATED( surf_v(3)%pt_surface ) .AND. kk == 1 ) & 4712 4985 READ ( 13 ) surf_v(3)%pt_surface 4713 CASE ( 'surf_v(3)%q_surface' ) 4986 CASE ( 'surf_v(3)%q_surface' ) 4714 4987 IF ( ALLOCATED( surf_v(3)%q_surface ) .AND. kk == 1 ) & 4715 4988 READ ( 13 ) surf_v(3)%q_surface 4716 CASE ( 'surf_v(3)%vpt_surface' ) 4989 CASE ( 'surf_v(3)%vpt_surface' ) 4717 4990 IF ( ALLOCATED( surf_v(3)%vpt_surface ) .AND. kk == 1 ) & 4718 4991 READ ( 13 ) surf_v(3)%vpt_surface 4719 CASE ( 'surf_v(3)%shf' ) 4992 CASE ( 'surf_v(3)%shf' ) 4720 4993 IF ( ALLOCATED( surf_v(3)%shf ) .AND. kk == 1 ) & 4721 4994 READ ( 13 ) surf_v(3)%shf 4722 CASE ( 'surf_v(3)%qsws' ) 4723 IF ( ALLOCATED( surf_v(3)%qsws ) .AND. kk == 1 ) & 4995 CASE ( 'surf_v(3)%qsws' ) 4996 IF ( ALLOCATED( surf_v(3)%qsws ) .AND. kk == 1 ) & 4724 4997 READ ( 13 ) surf_v(3)%qsws 4725 CASE ( 'surf_v(3)%ssws' ) 4998 CASE ( 'surf_v(3)%ssws' ) 4726 4999 IF ( ALLOCATED( surf_v(3)%ssws ) .AND. kk == 1 ) & 4727 5000 READ ( 13 ) surf_v(3)%ssws 4728 CASE ( 'surf_v(3)%css' ) 5001 CASE ( 'surf_v(3)%css' ) 4729 5002 IF ( ALLOCATED( surf_v(3)%css ) .AND. kk == 1 ) & 4730 5003 READ ( 13 ) surf_v(3)%css 4731 CASE ( 'surf_v(3)%cssws' ) 5004 CASE ( 'surf_v(3)%cssws' ) 4732 5005 IF ( ALLOCATED( surf_v(3)%cssws ) .AND. kk == 1 ) & 4733 5006 READ ( 13 ) surf_v(3)%cssws 4734 CASE ( 'surf_v(3)%qcsws' ) 5007 CASE ( 'surf_v(3)%qcsws' ) 4735 5008 IF ( ALLOCATED( surf_v(3)%qcsws ) .AND. kk == 1 ) & 4736 5009 READ ( 13 ) surf_v(3)%qcsws 4737 CASE ( 'surf_v(3)%ncsws' ) 5010 CASE ( 'surf_v(3)%ncsws' ) 4738 5011 IF ( ALLOCATED( surf_v(3)%ncsws ) .AND. kk == 1 ) & 4739 5012 READ ( 13 ) surf_v(3)%ncsws 4740 CASE ( 'surf_v(3)%qrsws' ) 5013 CASE ( 'surf_v(3)%qisws' ) 5014 IF ( ALLOCATED( surf_v(3)%qisws ) .AND. kk == 1 ) & 5015 READ ( 13 ) surf_v(3)%qisws 5016 CASE ( 'surf_v(3)%nisws' ) 5017 IF ( ALLOCATED( surf_v(3)%nisws ) .AND. kk == 1 ) & 5018 READ ( 13 ) surf_v(3)%nisws 5019 CASE ( 'surf_v(3)%qrsws' ) 4741 5020 IF ( ALLOCATED( surf_v(3)%qrsws ) .AND. kk == 1 ) & 4742 5021 READ ( 13 ) surf_v(3)%qrsws 4743 CASE ( 'surf_v(3)%nrsws' ) 5022 CASE ( 'surf_v(3)%nrsws' ) 4744 5023 IF ( ALLOCATED( surf_v(3)%nrsws ) .AND. kk == 1 ) & 4745 5024 READ ( 13 ) surf_v(3)%nrsws 4746 CASE ( 'surf_v(3)%sasws' ) 5025 CASE ( 'surf_v(3)%sasws' ) 4747 5026 IF ( ALLOCATED( surf_v(3)%sasws ) .AND. kk == 1 ) & 4748 5027 READ ( 13 ) surf_v(3)%sasws 4749 CASE ( 'surf_v(3)%mom_uv' ) 5028 CASE ( 'surf_v(3)%mom_uv' ) 4750 5029 IF ( ALLOCATED( surf_v(3)%mom_flux_uv ) .AND. kk == 1 ) & 4751 5030 READ ( 13 ) surf_v(3)%mom_flux_uv 4752 CASE ( 'surf_v(3)%mom_w' ) 5031 CASE ( 'surf_v(3)%mom_w' ) 4753 5032 IF ( ALLOCATED( surf_v(3)%mom_flux_w ) .AND. kk == 1 ) & 4754 5033 READ ( 13 ) surf_v(3)%mom_flux_w 4755 CASE ( 'surf_v(3)%mom_tke' ) 5034 CASE ( 'surf_v(3)%mom_tke' ) 4756 5035 IF ( ALLOCATED( surf_v(3)%mom_flux_tke ) .AND. kk == 1 ) & 4757 5036 READ ( 13 ) surf_v(3)%mom_flux_tke … … 4763 5042 END SELECT 4764 5043 ! 4765 !-- Redistribute surface elements on its respective type. Start with 5044 !-- Redistribute surface elements on its respective type. Start with 4766 5045 !-- horizontally orientated surfaces. 4767 5046 IF ( horizontal_surface .AND. & 4768 5047 .NOT. INDEX( restart_string(1:length), '%start_index' ) /= 0 ) & 4769 5048 THEN 4770 5049 4771 5050 ic = nxlc 4772 5051 DO i = nxlf, nxrf … … 4774 5053 DO j = nysf, nynf 4775 5054 ! 4776 !-- Determine type of surface element, i.e. default, natural, 4777 !-- urban, at current grid point. 5055 !-- Determine type of surface element, i.e. default, natural, 5056 !-- urban, at current grid point. 4778 5057 surf_match_def = surf_def_h(l)%end_index(jc,ic) >= & 4779 5058 surf_def_h(l)%start_index(jc,ic) 4780 5059 surf_match_lsm = ( surf_lsm_h%end_index(jc,ic) >= & 4781 5060 surf_lsm_h%start_index(jc,ic) ) & 4782 .AND. l == 0 5061 .AND. l == 0 4783 5062 surf_match_usm = ( surf_usm_h%end_index(jc,ic) >= & 4784 5063 surf_usm_h%start_index(jc,ic) ) & 4785 .AND. l == 0 5064 .AND. l == 0 4786 5065 ! 4787 5066 !-- Write restart data onto default-type surfaces if required. 4788 5067 IF ( surf_match_def ) THEN 4789 5068 ! 4790 !-- Set the start index for the local surface element 5069 !-- Set the start index for the local surface element 4791 5070 mm = surf_def_h(l)%start_index(jc,ic) 4792 5071 ! … … 4794 5073 !-- and in case the local surface element mm is smaller than 4795 5074 !-- the local end index, assign the respective surface data 4796 !-- to this element. 5075 !-- to this element. 4797 5076 DO m = surf_h(l)%start_index(j,i), & 4798 5077 surf_h(l)%end_index(j,i) … … 4805 5084 ! 4806 5085 !-- Same for natural-type surfaces. Please note, it is implicitly 4807 !-- assumed that natural surface elements are below urban 5086 !-- assumed that natural surface elements are below urban 4808 5087 !-- urban surface elements if there are several horizontal surfaces 4809 !-- at (j,i). An example would be bridges. 5088 !-- at (j,i). An example would be bridges. 4810 5089 IF ( surf_match_lsm ) THEN 4811 5090 mm = surf_lsm_h%start_index(jc,ic) … … 4843 5122 DO j = nysf, nynf 4844 5123 ! 4845 !-- Determine type of surface element, i.e. default, natural, 4846 !-- urban, at current grid point. 5124 !-- Determine type of surface element, i.e. default, natural, 5125 !-- urban, at current grid point. 4847 5126 surf_match_def = surf_def_v(l)%end_index(jc,ic) >= & 4848 5127 surf_def_v(l)%start_index(jc,ic) … … 4852 5131 surf_usm_v(l)%start_index(jc,ic) 4853 5132 ! 4854 !-- Write restart data onto default-type surfaces if required. 5133 !-- Write restart data onto default-type surfaces if required. 4855 5134 IF ( surf_match_def ) THEN 4856 5135 ! 4857 !-- Set the start index for the local surface element 5136 !-- Set the start index for the local surface element 4858 5137 mm = surf_def_v(l)%start_index(jc,ic) 4859 5138 ! … … 4861 5140 !-- and in case the local surface element mm is smaller than 4862 5141 !-- the local end index, assign the respective surface data 4863 !-- to this element. 5142 !-- to this element. 4864 5143 DO m = surf_v(l)%start_index(j,i), & 4865 5144 surf_v(l)%end_index(j,i) … … 4872 5151 ! 4873 5152 !-- Same for natural-type surfaces. Please note, it is implicitly 4874 !-- assumed that natural surface elements are below urban 5153 !-- assumed that natural surface elements are below urban 4875 5154 !-- urban surface elements if there are several vertical surfaces 4876 !-- at (j,i). An example a terrain elevations with a building on 5155 !-- at (j,i). An example a terrain elevations with a building on 4877 5156 !-- top. So far, initialization of urban surfaces below natural 4878 5157 !-- surfaces on the same (j,i) is not possible, so that this case 4879 !-- cannot occur. 5158 !-- cannot occur. 4880 5159 IF ( surf_match_lsm ) THEN 4881 5160 mm = surf_lsm_v(l)%start_index(jc,ic) … … 4918 5197 IMPLICIT NONE 4919 5198 4920 INTEGER(iwp) :: m_file !< respective surface-element index of current surface array 5199 INTEGER(iwp) :: m_file !< respective surface-element index of current surface array 4921 5200 INTEGER(iwp) :: m_target !< respecitve surface-element index of surface array on file 4922 5201 INTEGER(iwp) :: lsp !< running index chemical species … … 4926 5205 4927 5206 4928 IF ( INDEX( restart_string(1:length), '%us' ) /= 0 ) THEN 5207 IF ( INDEX( restart_string(1:length), '%us' ) /= 0 ) THEN 4929 5208 IF ( ALLOCATED( surf_target%us ) .AND. & 4930 ALLOCATED( surf_file%us ) ) & 5209 ALLOCATED( surf_file%us ) ) & 4931 5210 surf_target%us(m_target) = surf_file%us(m_file) 4932 5211 ENDIF 4933 5212 4934 IF ( INDEX( restart_string(1:length), '%ol' ) /= 0 ) THEN 5213 IF ( INDEX( restart_string(1:length), '%ol' ) /= 0 ) THEN 4935 5214 IF ( ALLOCATED( surf_target%ol ) .AND. & 4936 ALLOCATED( surf_file%ol ) ) & 5215 ALLOCATED( surf_file%ol ) ) & 4937 5216 surf_target%ol(m_target) = surf_file%ol(m_file) 4938 5217 ENDIF 4939 5218 4940 IF ( INDEX( restart_string(1:length), '%pt_surface' ) /= 0 ) THEN 5219 IF ( INDEX( restart_string(1:length), '%pt_surface' ) /= 0 ) THEN 4941 5220 IF ( ALLOCATED( surf_target%pt_surface ) .AND. & 4942 ALLOCATED( surf_file%pt_surface ) ) & 5221 ALLOCATED( surf_file%pt_surface ) ) & 4943 5222 surf_target%pt_surface(m_target) = surf_file%pt_surface(m_file) 4944 5223 ENDIF 4945 4946 IF ( INDEX( restart_string(1:length), '%q_surface' ) /= 0 ) THEN 5224 5225 IF ( INDEX( restart_string(1:length), '%q_surface' ) /= 0 ) THEN 4947 5226 IF ( ALLOCATED( surf_target%q_surface ) .AND. & 4948 ALLOCATED( surf_file%q_surface ) ) & 5227 ALLOCATED( surf_file%q_surface ) ) & 4949 5228 surf_target%q_surface(m_target) = surf_file%q_surface(m_file) 4950 5229 ENDIF 4951 5230 4952 IF ( INDEX( restart_string(1:length), '%vpt_surface' ) /= 0 ) THEN 5231 IF ( INDEX( restart_string(1:length), '%vpt_surface' ) /= 0 ) THEN 4953 5232 IF ( ALLOCATED( surf_target%vpt_surface ) .AND. & 4954 ALLOCATED( surf_file%vpt_surface ) ) & 5233 ALLOCATED( surf_file%vpt_surface ) ) & 4955 5234 surf_target%vpt_surface(m_target) = surf_file%vpt_surface(m_file) 4956 5235 ENDIF 4957 4958 IF ( INDEX( restart_string(1:length), '%usws' ) /= 0 ) THEN 5236 5237 IF ( INDEX( restart_string(1:length), '%usws' ) /= 0 ) THEN 4959 5238 IF ( ALLOCATED( surf_target%usws ) .AND. & 4960 ALLOCATED( surf_file%usws ) ) & 5239 ALLOCATED( surf_file%usws ) ) & 4961 5240 surf_target%usws(m_target) = surf_file%usws(m_file) 4962 5241 ENDIF 4963 5242 4964 IF ( INDEX( restart_string(1:length), '%vsws' ) /= 0 ) THEN 5243 IF ( INDEX( restart_string(1:length), '%vsws' ) /= 0 ) THEN 4965 5244 IF ( ALLOCATED( surf_target%vsws ) .AND. & 4966 ALLOCATED( surf_file%vsws ) ) & 5245 ALLOCATED( surf_file%vsws ) ) & 4967 5246 surf_target%vsws(m_target) = surf_file%vsws(m_file) 4968 5247 ENDIF 4969 5248 4970 IF ( INDEX( restart_string(1:length), '%ts' ) /= 0 ) THEN 5249 IF ( INDEX( restart_string(1:length), '%ts' ) /= 0 ) THEN 4971 5250 IF ( ALLOCATED( surf_target%ts ) .AND. & 4972 ALLOCATED( surf_file%ts ) ) & 5251 ALLOCATED( surf_file%ts ) ) & 4973 5252 surf_target%ts(m_target) = surf_file%ts(m_file) 4974 5253 ENDIF 4975 5254 4976 IF ( INDEX( restart_string(1:length), '%shf' ) /= 0 ) THEN 5255 IF ( INDEX( restart_string(1:length), '%shf' ) /= 0 ) THEN 4977 5256 IF ( ALLOCATED( surf_target%shf ) .AND. & 4978 ALLOCATED( surf_file%shf ) ) & 5257 ALLOCATED( surf_file%shf ) ) & 4979 5258 surf_target%shf(m_target) = surf_file%shf(m_file) 4980 5259 ENDIF 4981 5260 4982 IF ( INDEX( restart_string(1:length), '%qs' ) /= 0 ) THEN 5261 IF ( INDEX( restart_string(1:length), '%qs' ) /= 0 ) THEN 4983 5262 IF ( ALLOCATED( surf_target%qs ) .AND. & 4984 ALLOCATED( surf_file%qs ) ) & 5263 ALLOCATED( surf_file%qs ) ) & 4985 5264 surf_target%qs(m_target) = surf_file%qs(m_file) 4986 5265 ENDIF 4987 5266 4988 IF ( INDEX( restart_string(1:length), '%qsws' ) /= 0 ) THEN 5267 IF ( INDEX( restart_string(1:length), '%qsws' ) /= 0 ) THEN 4989 5268 IF ( ALLOCATED( surf_target%qsws ) .AND. & 4990 ALLOCATED( surf_file%qsws ) ) & 5269 ALLOCATED( surf_file%qsws ) ) & 4991 5270 surf_target%qsws(m_target) = surf_file%qsws(m_file) 4992 5271 ENDIF 4993 5272 4994 IF ( INDEX( restart_string(1:length), '%ss' ) /= 0 ) THEN 5273 IF ( INDEX( restart_string(1:length), '%ss' ) /= 0 ) THEN 4995 5274 IF ( ALLOCATED( surf_target%ss ) .AND. & 4996 ALLOCATED( surf_file%ss ) ) & 5275 ALLOCATED( surf_file%ss ) ) & 4997 5276 surf_target%ss(m_target) = surf_file%ss(m_file) 4998 5277 ENDIF 4999 5278 5000 IF ( INDEX( restart_string(1:length), '%ssws' ) /= 0 ) THEN 5279 IF ( INDEX( restart_string(1:length), '%ssws' ) /= 0 ) THEN 5001 5280 IF ( ALLOCATED( surf_target%ssws ) .AND. & 5002 ALLOCATED( surf_file%ssws ) ) & 5281 ALLOCATED( surf_file%ssws ) ) & 5003 5282 surf_target%ssws(m_target) = surf_file%ssws(m_file) 5004 5283 ENDIF 5005 5284 5006 IF ( INDEX( restart_string(1:length), '%css' ) /= 0 ) THEN 5285 IF ( INDEX( restart_string(1:length), '%css' ) /= 0 ) THEN 5007 5286 IF ( ALLOCATED( surf_target%css ) .AND. & 5008 ALLOCATED( surf_file%css ) ) THEN 5287 ALLOCATED( surf_file%css ) ) THEN 5009 5288 DO lsp = 1, nvar 5010 5289 surf_target%css(lsp,m_target) = surf_file%css(lsp,m_file) … … 5012 5291 ENDIF 5013 5292 ENDIF 5014 IF ( INDEX( restart_string(1:length), '%cssws' ) /= 0 ) THEN 5293 IF ( INDEX( restart_string(1:length), '%cssws' ) /= 0 ) THEN 5015 5294 IF ( ALLOCATED( surf_target%cssws ) .AND. & 5016 ALLOCATED( surf_file%cssws ) ) THEN 5295 ALLOCATED( surf_file%cssws ) ) THEN 5017 5296 DO lsp = 1, nvar 5018 5297 surf_target%cssws(lsp,m_target) = surf_file%cssws(lsp,m_file) … … 5021 5300 ENDIF 5022 5301 5023 IF ( INDEX( restart_string(1:length), '%qcs' ) /= 0 ) THEN 5302 IF ( INDEX( restart_string(1:length), '%qcs' ) /= 0 ) THEN 5024 5303 IF ( ALLOCATED( surf_target%qcs ) .AND. & 5025 ALLOCATED( surf_file%qcs ) ) & 5304 ALLOCATED( surf_file%qcs ) ) & 5026 5305 surf_target%qcs(m_target) = surf_file%qcs(m_file) 5027 5306 ENDIF 5028 5307 5029 IF ( INDEX( restart_string(1:length), '%qcsws' ) /= 0 ) THEN 5308 IF ( INDEX( restart_string(1:length), '%qcsws' ) /= 0 ) THEN 5030 5309 IF ( ALLOCATED( surf_target%qcsws ) .AND. & 5031 ALLOCATED( surf_file%qcsws ) ) & 5310 ALLOCATED( surf_file%qcsws ) ) & 5032 5311 surf_target%qcsws(m_target) = surf_file%qcsws(m_file) 5033 5312 ENDIF 5034 5313 5035 IF ( INDEX( restart_string(1:length), '%ncs' ) /= 0 ) THEN 5314 IF ( INDEX( restart_string(1:length), '%ncs' ) /= 0 ) THEN 5036 5315 IF ( ALLOCATED( surf_target%ncs ) .AND. & 5037 ALLOCATED( surf_file%ncs ) ) & 5316 ALLOCATED( surf_file%ncs ) ) & 5038 5317 surf_target%ncs(m_target) = surf_file%ncs(m_file) 5039 5318 ENDIF 5040 5319 5041 IF ( INDEX( restart_string(1:length), '%ncsws' ) /= 0 ) THEN 5320 IF ( INDEX( restart_string(1:length), '%ncsws' ) /= 0 ) THEN 5042 5321 IF ( ALLOCATED( surf_target%ncsws ) .AND. & 5043 ALLOCATED( surf_file%ncsws ) ) & 5322 ALLOCATED( surf_file%ncsws ) ) & 5044 5323 surf_target%ncsws(m_target) = surf_file%ncsws(m_file) 5045 5324 ENDIF 5046 5325 5047 IF ( INDEX( restart_string(1:length), '%qrs' ) /= 0 ) THEN 5326 IF ( INDEX( restart_string(1:length), '%qis' ) /= 0 ) THEN 5327 IF ( ALLOCATED( surf_target%qis ) .AND. & 5328 ALLOCATED( surf_file%qis ) ) & 5329 surf_target%qis(m_target) = surf_file%qis(m_file) 5330 ENDIF 5331 5332 IF ( INDEX( restart_string(1:length), '%qisws' ) /= 0 ) THEN 5333 IF ( ALLOCATED( surf_target%qisws ) .AND. & 5334 ALLOCATED( surf_file%qisws ) ) & 5335 surf_target%qisws(m_target) = surf_file%qisws(m_file) 5336 ENDIF 5337 5338 IF ( INDEX( restart_string(1:length), '%nis' ) /= 0 ) THEN 5339 IF ( ALLOCATED( surf_target%nis ) .AND. & 5340 ALLOCATED( surf_file%nis ) ) & 5341 surf_target%nis(m_target) = surf_file%nis(m_file) 5342 ENDIF 5343 5344 IF ( INDEX( restart_string(1:length), '%nisws' ) /= 0 ) THEN 5345 IF ( ALLOCATED( surf_target%nisws ) .AND. & 5346 ALLOCATED( surf_file%nisws ) ) & 5347 surf_target%nisws(m_target) = surf_file%nisws(m_file) 5348 ENDIF 5349 5350 IF ( INDEX( restart_string(1:length), '%qrs' ) /= 0 ) THEN 5048 5351 IF ( ALLOCATED( surf_target%qrs ) .AND. & 5049 ALLOCATED( surf_file%qrs ) ) & 5352 ALLOCATED( surf_file%qrs ) ) & 5050 5353 surf_target%qrs(m_target) = surf_file%qrs(m_file) 5051 5354 ENDIF 5052 5355 5053 IF ( INDEX( restart_string(1:length), '%qrsws' ) /= 0 ) THEN 5356 IF ( INDEX( restart_string(1:length), '%qrsws' ) /= 0 ) THEN 5054 5357 IF ( ALLOCATED( surf_target%qrsws ) .AND. & 5055 ALLOCATED( surf_file%qrsws ) ) & 5358 ALLOCATED( surf_file%qrsws ) ) & 5056 5359 surf_target%qrsws(m_target) = surf_file%qrsws(m_file) 5057 5360 ENDIF 5058 5361 5059 IF ( INDEX( restart_string(1:length), '%nrs' ) /= 0 ) THEN 5362 IF ( INDEX( restart_string(1:length), '%nrs' ) /= 0 ) THEN 5060 5363 IF ( ALLOCATED( surf_target%nrs ) .AND. & 5061 ALLOCATED( surf_file%nrs ) ) & 5364 ALLOCATED( surf_file%nrs ) ) & 5062 5365 surf_target%nrs(m_target) = surf_file%nrs(m_file) 5063 5366 ENDIF 5064 5367 5065 IF ( INDEX( restart_string(1:length), '%nrsws' ) /= 0 ) THEN 5368 IF ( INDEX( restart_string(1:length), '%nrsws' ) /= 0 ) THEN 5066 5369 IF ( ALLOCATED( surf_target%nrsws ) .AND. & 5067 ALLOCATED( surf_file%nrsws ) ) & 5370 ALLOCATED( surf_file%nrsws ) ) & 5068 5371 surf_target%nrsws(m_target) = surf_file%nrsws(m_file) 5069 5372 ENDIF 5070 5373 5071 IF ( INDEX( restart_string(1:length), '%sasws' ) /= 0 ) THEN 5374 IF ( INDEX( restart_string(1:length), '%sasws' ) /= 0 ) THEN 5072 5375 IF ( ALLOCATED( surf_target%sasws ) .AND. & 5073 ALLOCATED( surf_file%sasws ) ) & 5376 ALLOCATED( surf_file%sasws ) ) & 5074 5377 surf_target%sasws(m_target) = surf_file%sasws(m_file) 5075 5378 ENDIF 5076 5379 5077 IF ( INDEX( restart_string(1:length), '%mom_uv' ) /= 0 ) THEN 5380 IF ( INDEX( restart_string(1:length), '%mom_uv' ) /= 0 ) THEN 5078 5381 IF ( ALLOCATED( surf_target%mom_flux_uv ) .AND. & 5079 ALLOCATED( surf_file%mom_flux_uv ) ) & 5382 ALLOCATED( surf_file%mom_flux_uv ) ) & 5080 5383 surf_target%mom_flux_uv(m_target) = & 5081 5384 surf_file%mom_flux_uv(m_file) 5082 5385 ENDIF 5083 5386 5084 IF ( INDEX( restart_string(1:length), '%mom_w' ) /= 0 ) THEN 5387 IF ( INDEX( restart_string(1:length), '%mom_w' ) /= 0 ) THEN 5085 5388 IF ( ALLOCATED( surf_target%mom_flux_w ) .AND. & 5086 ALLOCATED( surf_file%mom_flux_w ) ) & 5389 ALLOCATED( surf_file%mom_flux_w ) ) & 5087 5390 surf_target%mom_flux_w(m_target) = & 5088 5391 surf_file%mom_flux_w(m_file) 5089 5392 ENDIF 5090 5393 5091 IF ( INDEX( restart_string(1:length), '%mom_tke' ) /= 0 ) THEN 5394 IF ( INDEX( restart_string(1:length), '%mom_tke' ) /= 0 ) THEN 5092 5395 IF ( ALLOCATED( surf_target%mom_flux_tke ) .AND. & 5093 ALLOCATED( surf_file%mom_flux_tke ) ) & 5396 ALLOCATED( surf_file%mom_flux_tke ) ) & 5094 5397 surf_target%mom_flux_tke(0:1,m_target) = & 5095 5398 surf_file%mom_flux_tke(0:1,m_file) … … 5102 5405 END SUBROUTINE surface_rrd_local 5103 5406 5104 5407 5105 5408 !------------------------------------------------------------------------------! 5106 5409 ! Description: 5107 5410 ! ------------ 5108 !> Counts the number of surface elements with the same facing, required for 5411 !> Counts the number of surface elements with the same facing, required for 5109 5412 !> reading and writing restart data. 5110 5413 !------------------------------------------------------------------------------! … … 5129 5432 ! Description: 5130 5433 ! ------------ 5131 !> Routine maps surface data read from file after restart - 1D arrays. 5434 !> Routine maps surface data read from file after restart - 1D arrays. 5132 5435 !------------------------------------------------------------------------------! 5133 5436 SUBROUTINE surface_restore_elements_1d( surf_target, surf_file, & … … 5140 5443 5141 5444 IMPLICIT NONE 5142 5445 5143 5446 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 5144 5447 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 5145 5448 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 5146 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 5449 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 5147 5450 INTEGER(iwp) :: m !< surface-element index on file 5148 5451 INTEGER(iwp) :: mm !< surface-element index on current subdomain 5149 5452 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 5150 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 5453 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 5151 5454 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 5152 5455 INTEGER(iwp) :: nysc !< index of north boundary on current subdomain … … 5159 5462 INTEGER(iwp) :: nys_on_file !< southmost index on file 5160 5463 5161 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c 5162 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5464 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c 5465 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5163 5466 start_index_on_file !< start index of surface elements on file 5164 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5467 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5165 5468 end_index_on_file !< end index of surface elements on file 5166 5469 5167 5470 REAL(wp), DIMENSION(:) :: surf_target !< target surface type 5168 5471 REAL(wp), DIMENSION(:) :: surf_file !< surface type on file … … 5186 5489 5187 5490 END SUBROUTINE surface_restore_elements_1d 5188 5491 5189 5492 !------------------------------------------------------------------------------! 5190 5493 ! Description: 5191 5494 ! ------------ 5192 5495 !> Routine maps surface data read from file after restart - 2D arrays 5193 !------------------------------------------------------------------------------! 5496 !------------------------------------------------------------------------------! 5194 5497 SUBROUTINE surface_restore_elements_2d( surf_target, surf_file, & 5195 5498 start_index_c, & … … 5201 5504 5202 5505 IMPLICIT NONE 5203 5506 5204 5507 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 5205 5508 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 5206 5509 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 5207 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 5510 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 5208 5511 INTEGER(iwp) :: m !< surface-element index on file 5209 5512 INTEGER(iwp) :: mm !< surface-element index on current subdomain 5210 5513 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 5211 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 5514 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 5212 5515 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 5213 5516 INTEGER(iwp) :: nysc !< index of north boundary on current subdomain … … 5221 5524 5222 5525 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c !< start index of surface type 5223 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5526 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5224 5527 start_index_on_file !< start index of surface elements on file 5225 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5528 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5226 5529 end_index_on_file !< end index of surface elements on file 5227 5530 5228 5531 REAL(wp), DIMENSION(:,:) :: surf_target !< target surface type 5229 5532 REAL(wp), DIMENSION(:,:) :: surf_file !< surface type on file 5230 5533 5231 5534 ic = nxlc 5232 5535 DO i = nxlf, nxrf -
palm/trunk/SOURCE/time_integration.f90
r4472 r4502 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 23 ! 22 ! 23 ! 24 24 ! Former revisions: 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Implementation of ice microphysics 28 ! 29 ! 4472 2020-03-24 12:21:00Z Giersch 27 30 ! OPENACC COPYIN directive for ddx and ddy added 28 31 ! … … 211 214 USE arrays_3d, & 212 215 ONLY: diss, diss_p, dzu, e_p, nc_p, nr_p, prho, pt, pt_p, pt_init, q, qc_p, qr_p, q_init, & 213 q_p, ref_state, rho_ocean, sa_p, s_p, tend, u, u_p, v, vpt, v_p, w_p 216 q_p, ref_state, rho_ocean, sa_p, s_p, tend, u, u_p, v, vpt, v_p, w_p, & 217 qi_p, ni_p 214 218 215 219 #if defined( __parallel ) && ! defined( _OPENACC ) 216 220 USE arrays_3d, & 217 ONLY: e, nc, nr, qc, qr, s, w 221 ONLY: e, nc, nr, qc, qr, s, w, qi, ni 218 222 #endif 219 223 … … 224 228 USE bulk_cloud_model_mod, & 225 229 ONLY: bulk_cloud_model, calc_liquid_water_content, collision_turbulence, & 226 microphysics_morrison, microphysics_seifert 230 microphysics_morrison, microphysics_seifert, microphysics_ice_extension 227 231 228 232 USE calc_mean_profile_mod, & … … 432 436 kh, km, momentumflux_output_conversion, nc, nr, p, ptdf_x, ptdf_y, qc, qr, rdf, & 433 437 rdf_sc, rho_air, rho_air_zw, s, tdiss_m, te_m, tpt_m, tu_m, tv_m, tw_m, ug, u_init, & 434 u_stokes_zu, vg, v_init, v_stokes_zu, w, zu 438 u_stokes_zu, vg, v_init, v_stokes_zu, w, zu, qi, ni 435 439 436 440 USE control_parameters, & … … 444 448 sums_wsus_ws_l, sums_vs2_ws_l, sums_wsvs_ws_l, sums_ws2_ws_l, sums_wspts_ws_l, & 445 449 sums_wsqs_ws_l, sums_wssas_ws_l, sums_wsqcs_ws_l, sums_wsqrs_ws_l, sums_wsncs_ws_l, & 446 sums_wsnrs_ws_l, sums_wsss_ws_l, weight_substep, sums_salsa_ws_l 450 sums_wsnrs_ws_l, sums_wsss_ws_l, weight_substep, sums_salsa_ws_l, & 451 sums_wsqis_ws_l, sums_wsnis_ws_l 447 452 448 453 USE surface_mod, & … … 571 576 !$ACC COPY(sums_wsqs_ws_l(nzb:nzt+1,0)) & 572 577 !$ACC COPY(sums_wsqcs_ws_l(nzb:nzt+1,0)) & 578 !$ACC COPY(sums_wsqis_ws_l(nzb:nzt+1,0)) & 573 579 !$ACC COPY(sums_wsqrs_ws_l(nzb:nzt+1,0)) & 574 580 !$ACC COPY(sums_wsncs_ws_l(nzb:nzt+1,0)) & 581 !$ACC COPY(sums_wsnis_ws_l(nzb:nzt+1,0)) & 575 582 !$ACC COPY(sums_wsnrs_ws_l(nzb:nzt+1,0)) & 576 583 !$ACC COPY(sums_wsss_ws_l(nzb:nzt+1,0)) & … … 805 812 CALL exchange_horiz( nr_p, nbgp ) 806 813 ENDIF 814 IF ( bulk_cloud_model .AND. microphysics_ice_extension ) THEN 815 CALL exchange_horiz( qi_p, nbgp ) 816 CALL exchange_horiz( ni_p, nbgp ) 817 ENDIF 807 818 ENDIF 808 819 IF ( passive_scalar ) CALL exchange_horiz( s_p, nbgp ) … … 894 905 CALL exchange_horiz( nr, nbgp ) 895 906 ENDIF 896 907 IF ( bulk_cloud_model .AND. microphysics_ice_extension ) THEN 908 CALL exchange_horiz( qi, nbgp ) 909 CALL exchange_horiz( ni, nbgp ) 910 ENDIF 897 911 ENDIF 898 912 … … 1219 1233 !$ACC HOST(sums_wsqs_ws_l(nzb:nzt+1,0)) & 1220 1234 !$ACC HOST(sums_wsqcs_ws_l(nzb:nzt+1,0)) & 1235 !$ACC HOST(sums_wsqis_ws_l(nzb:nzt+1,0)) & 1221 1236 !$ACC HOST(sums_wsqrs_ws_l(nzb:nzt+1,0)) & 1222 1237 !$ACC HOST(sums_wsncs_ws_l(nzb:nzt+1,0)) & 1238 !$ACC HOST(sums_wsnis_ws_l(nzb:nzt+1,0)) & 1223 1239 !$ACC HOST(sums_wsnrs_ws_l(nzb:nzt+1,0)) & 1224 1240 !$ACC HOST(sums_wsss_ws_l(nzb:nzt+1,0)) &
Note: See TracChangeset
for help on using the changeset viewer.