Changeset 4450 for palm/trunk/SOURCE/land_surface_model_mod.f90
- Timestamp:
- Mar 9, 2020 7:12:57 PM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/land_surface_model_mod.f90 (modified) (328 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/land_surface_model_mod.f90
r4444 r4450 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Missing from_file check 28 ! 29 ! 4444 2020-03-05 15:59:50Z raasch 27 30 ! bugfix: cpp-directive moved 28 ! 31 ! 29 32 ! 4442 2020-03-04 19:21:13Z suehring 30 ! Change order of dimension in surface arrays %frac, %emissivity and %albedo 33 ! Change order of dimension in surface arrays %frac, %emissivity and %albedo 31 34 ! to allow for better vectorization in the radiation interactions. 32 ! 35 ! 33 36 ! 4441 2020-03-04 19:20:35Z suehring 34 37 ! bugfix: missing cpp-directives for serial mode added, misplaced cpp-directives moved 35 ! 38 ! 36 39 ! 4381 2020-01-20 13:51:46Z suehring 37 ! - Bugfix in nested soil initialization in case no dynamic input file is 40 ! - Bugfix in nested soil initialization in case no dynamic input file is 38 41 ! present 39 ! - In order to do not mess-up the job-protocoll, give error messages 503, 507 42 ! - In order to do not mess-up the job-protocoll, give error messages 503, 507 40 43 ! and 508 only once 41 ! 44 ! 42 45 ! 4360 2020-01-07 11:25:50Z suehring 43 46 ! Fix wrong location string in message call 44 ! 47 ! 45 48 ! 4356 2019-12-20 17:09:33Z suehring 46 49 ! Correct single message calls, local checks must be given by the respective 47 50 ! mpi rank. 48 ! 51 ! 49 52 ! 4339 2019-12-13 18:18:30Z suehring 50 53 ! Bugfix, character length too short, caused crash on NEC. 51 ! 54 ! 52 55 ! 4338 2019-12-13 13:23:23Z suehring 53 ! To avoid divisions by zero, add security factor in calculation of roughness 56 ! To avoid divisions by zero, add security factor in calculation of roughness 54 57 ! length over water surfaces. 55 ! 58 ! 56 59 ! 4321 2019-12-04 10:26:38Z pavelkrc 57 60 ! Initialization of relative surface fractions revised 58 ! 61 ! 59 62 ! 4312 2019-11-27 14:06:25Z suehring 60 63 ! Bugfix: partitioning of LE from liquid water reservoir fixed. Bare soils are 61 64 ! now allowed to store liquid water at the surface. 62 ! 65 ! 63 66 ! 4261 2019-10-09 17:58:00Z scharf 64 67 ! bugfix for rev. 4258: deallocate temporary arrays 65 ! 68 ! 66 69 ! 4258 2019-10-07 13:29:08Z suehring 67 ! - Revise limitation for soil moisture in case it exceeds its saturation 70 ! - Revise limitation for soil moisture in case it exceeds its saturation 68 71 ! value (J. Resler) 69 ! - Revise initialization of soil moisture and temperature in a nested run in 70 ! case dynamic input information is available. This case, the soil within 72 ! - Revise initialization of soil moisture and temperature in a nested run in 73 ! case dynamic input information is available. This case, the soil within 71 74 ! the child domains can be initialized separately. (J. Resler, M. Suehring) 72 ! - As part of this revision, migrate the netcdf input of soil temperature / 73 ! moisture to this module, as well as the routine to inter/extrapolate soil 74 ! profiles between different grids. 75 ! 75 ! - As part of this revision, migrate the netcdf input of soil temperature / 76 ! moisture to this module, as well as the routine to inter/extrapolate soil 77 ! profiles between different grids. 78 ! 76 79 ! 4251 2019-10-02 12:07:38Z maronga 77 80 ! Bugfix: albedo_types for vegetation_type look-up table corrected. 78 ! 81 ! 79 82 ! 4201 2019-08-29 15:47:27Z suehring 80 ! - Limit soil moisture to its saturation moisture and give a respective 83 ! - Limit soil moisture to its saturation moisture and give a respective 81 84 ! warning rather than an error. 82 85 ! - Perform checks for soil temperature only when there is no dynamic input 83 ! file for the parent or possible child domains. 84 ! 86 ! file for the parent or possible child domains. 87 ! 85 88 ! 4194 2019-08-28 08:09:44Z suehring 86 ! Apply more strict limitation of z0 over water surfaces in case it exceeds the 87 ! surface-layer height, in order to avoid instabilities. 88 ! 89 ! Apply more strict limitation of z0 over water surfaces in case it exceeds the 90 ! surface-layer height, in order to avoid instabilities. 91 ! 89 92 ! 4188 2019-08-26 14:15:47Z suehring 90 93 ! Minor adjustment in error numbers, typos corrected 91 ! 94 ! 92 95 ! 4187 2019-08-26 12:43:15Z suehring 93 96 ! Adjust message call in case of local checks 94 ! 97 ! 95 98 ! 4182 2019-08-22 15:20:23Z scharf 96 99 ! Corrected "Former revisions" section 97 ! 100 ! 98 101 ! 4118 2019-07-25 16:11:45Z suehring 99 102 ! Initialization of soil temperature and moisture via dynamic input file only 100 ! for vegetation and pavement surfaces. 101 ! 103 ! for vegetation and pavement surfaces. 104 ! 102 105 ! 4110 2019-07-22 17:05:21Z suehring 103 ! Relax checks for non-consistent initialization in case static or dynamic 106 ! Relax checks for non-consistent initialization in case static or dynamic 104 107 ! input is provided. For example, soil_temperature or deep_soil_temperature 105 ! is not mandatory any more if dynamic input is available. Also, improper 106 ! settings of x_type in namelist are only checked if no static file is 107 ! available. 108 ! 108 ! is not mandatory any more if dynamic input is available. Also, improper 109 ! settings of x_type in namelist are only checked if no static file is 110 ! available. 111 ! 109 112 ! 4109 2019-07-22 17:00:34Z suehring 110 ! Further revision of last commit in order to avoid any side effects when 111 ! albedo type is not set in namelist and default albedo type changes. 112 ! 113 ! Further revision of last commit in order to avoid any side effects when 114 ! albedo type is not set in namelist and default albedo type changes. 115 ! 113 116 ! 4024 2019-06-12 14:06:46Z suehring 114 117 ! Bugfix in albedo initialization, caused crashes in rrtmg calls 115 ! 118 ! 116 119 ! 3987 2019-05-22 09:52:13Z kanani 117 120 ! Introduce alternative switch for debug output during timestepping 118 ! 121 ! 119 122 ! 3964 2019-05-09 09:48:32Z suehring 120 ! In a nested child domain, distinguish between soil moisture and temperature 123 ! In a nested child domain, distinguish between soil moisture and temperature 121 124 ! initialization from parent via dynamic input file. Further, initialize soil 122 125 ! moisture/temperature from dynamic input file only when initialization via 123 126 ! 'inifor' is desired. 124 ! 127 ! 125 128 ! 3943 2019-05-02 09:50:41Z maronga 126 129 ! Removed extra blank character 127 ! 130 ! 128 131 ! 3941 2019-04-30 09:48:33Z suehring 129 132 ! Check that at least one surface type is set at surface element. 130 ! 133 ! 131 134 ! 3933 2019-04-25 12:33:20Z kanani 132 135 ! Remove unused subroutine and allocation of pt_2m, this is done in surface_mod 133 136 ! now (surfaces%pt_2m) 134 ! 135 ! 136 ! Changes related to global restructuring of location messages and introduction 137 ! 138 ! 139 ! Changes related to global restructuring of location messages and introduction 137 140 ! of additional debug messages 138 ! 141 ! 139 142 ! 3881 2019-04-10 09:31:22Z suehring 140 ! Bugfix in level 3 initialization of pavement albedo type and pavement 143 ! Bugfix in level 3 initialization of pavement albedo type and pavement 141 144 ! emissivity 142 ! 145 ! 143 146 ! 3868 2019-04-08 11:52:36Z suehring 144 ! More strict limitation of roughness length when it is in the order of the 145 ! vertical grid spacing 146 ! 147 ! More strict limitation of roughness length when it is in the order of the 148 ! vertical grid spacing 149 ! 147 150 ! 3856 2019-04-03 11:06:59Z suehring 148 151 ! Bugfix in lsm_init in case no surface-fractions are provided 149 ! 152 ! 150 153 ! 3847 2019-04-01 14:51:44Z suehring 151 ! Adjust message-call for checks that are especially carried out locally. 152 ! 154 ! Adjust message-call for checks that are especially carried out locally. 155 ! 153 156 ! 3832 2019-03-28 13:16:58Z raasch 154 157 ! instrumented with openmp directives 155 ! 158 ! 156 159 ! 3786 2019-03-06 16:58:03Z raasch 157 160 ! further unused variables removed 158 ! 161 ! 159 162 ! 3767 2019-02-27 08:18:02Z raasch 160 163 ! unused variable for file index removed from rrd-subroutines parameter list 161 ! 164 ! 162 165 ! 3715 2019-02-04 17:34:55Z suehring 163 166 ! Revise check for saturation moisture 164 ! 167 ! 165 168 ! 3710 2019-01-30 18:11:19Z suehring 166 169 ! Check if soil-, water-, pavement- and vegetation types are set within a valid 167 170 ! range. 168 ! 171 ! 169 172 ! 3692 2019-01-23 14:45:49Z suehring 170 173 ! Revise check for soil moisture higher than its saturation value 171 ! 174 ! 172 175 ! 3685 2019-01-21 01:02:11Z knoop 173 176 ! Some interface calls moved to module_interface + cleanup 174 ! 177 ! 175 178 ! 3677 2019-01-17 09:07:06Z moh.hefny 176 179 ! Removed most_method 177 ! 180 ! 178 181 ! 3655 2019-01-07 16:51:22Z knoop 179 182 ! nopointer option removed 180 ! 183 ! 181 184 ! 1496 2014-12-02 17:25:50Z maronga 182 185 ! Initial revision 183 ! 186 ! 184 187 ! 185 188 ! Description: … … 188 191 !> surface and a multi layer soil scheme. The scheme is similar to the TESSEL 189 192 !> scheme implemented in the ECMWF IFS model, with modifications according to 190 !> H-TESSEL. The implementation is based on the formulation implemented in the 193 !> H-TESSEL. The implementation is based on the formulation implemented in the 191 194 !> DALES and UCLA-LES models. 192 195 !> 193 !> @todo Extensive verification energy-balance solver for vertical surfaces, 196 !> @todo Extensive verification energy-balance solver for vertical surfaces, 194 197 !> e.g. parametrization of r_a 195 !> @todo Revise single land-surface processes for vertical surfaces, e.g. 196 !> treatment of humidity, etc. 197 !> @todo Consider partial absorption of the net shortwave radiation by the 198 !> @todo Revise single land-surface processes for vertical surfaces, e.g. 199 !> treatment of humidity, etc. 200 !> @todo Consider partial absorption of the net shortwave radiation by the 198 201 !> skin layer. 199 202 !> @todo Improve surface water parameterization 200 !> @todo Invert indices (running from -3 to 0. Currently: nzb_soil=0, 203 !> @todo Invert indices (running from -3 to 0. Currently: nzb_soil=0, 201 204 !> nzt_soil=3)). 202 !> @todo Implement surface runoff model (required when performing long-term LES 205 !> @todo Implement surface runoff model (required when performing long-term LES 203 206 !> with considerable precipitation. 204 207 !> @todo Revise calculation of f2 when wilting point is non-constant in the … … 207 210 !> @note No time step criterion is required as long as the soil layers do not 208 211 !> become too thin. 209 !> @todo Attention, pavement_subpars_1/2 are hardcoded to 8 levels, in case 212 !> @todo Attention, pavement_subpars_1/2 are hardcoded to 8 levels, in case 210 213 !> more levels are used this may cause an potential bug 211 214 !> @todo Routine calc_q_surface required? … … 213 216 !------------------------------------------------------------------------------! 214 217 MODULE land_surface_model_mod 215 218 216 219 USE arrays_3d, & 217 220 ONLY: hyp, pt, prr, q, q_p, ql, vpt, u, v, w, hyrho, exner, d_exner … … 235 238 surface_pressure, timestep_scheme, tsc, & 236 239 time_since_reference_point 237 240 238 241 USE cpulog, & 239 242 ONLY: cpu_log, log_point_s … … 274 277 vegetation_type_f, & 275 278 water_pars_f, & 276 water_type_f 279 water_type_f 277 280 278 281 USE kinds … … 283 286 ONLY: albedo, albedo_type, emissivity, force_radiation_call, & 284 287 radiation, radiation_scheme, unscheduled_radiation_calls 285 288 286 289 USE statistics, & 287 290 ONLY: hom, statistic_regions … … 303 306 REAL(wp), PARAMETER :: & 304 307 b_ch = 6.04_wp, & ! Clapp & Hornberger exponent 305 lambda_h_dry = 0.19_wp, & ! heat conductivity for dry soil (W/m/K) 308 lambda_h_dry = 0.19_wp, & ! heat conductivity for dry soil (W/m/K) 306 309 lambda_h_sm = 3.44_wp, & ! heat conductivity of the soil matrix (W/m/K) 307 310 lambda_h_water = 0.57_wp, & ! heat conductivity of water (W/m/K) … … 329 332 !-- LSM variables 330 333 CHARACTER(10) :: surface_type = 'netcdf' !< general classification. Allowed are: 331 !< 'vegetation', 'pavement', ('building'), 334 !< 'vegetation', 'pavement', ('building'), 332 335 !< 'water', and 'netcdf' 333 336 … … 339 342 nzs = 8, & !< number of soil layers 340 343 pavement_depth_level = 0, & !< default NAMELIST nzt_pavement 341 pavement_type = 1, & !< default NAMELIST pavement_type 344 pavement_type = 1, & !< default NAMELIST pavement_type 342 345 soil_type = 3, & !< default NAMELIST soil_type 343 346 vegetation_type = 2, & !< default NAMELIST vegetation_type 344 347 water_type = 1 !< default NAMELISt water_type 345 346 347 348 349 350 348 351 LOGICAL :: conserve_water_content = .TRUE., & !< open or closed bottom surface for the soil model 349 352 constant_roughness = .FALSE., & !< use fixed/dynamic roughness lengths for water surfaces … … 390 393 z0_water = 9999999.9_wp, & !< NAMELIST z0 (lsm_par) 391 394 z0h_water = 9999999.9_wp, & !< NAMELIST z0h (lsm_par) 392 z0q_water = 9999999.9_wp !< NAMELIST z0q (lsm_par) 393 394 395 z0q_water = 9999999.9_wp !< NAMELIST z0q (lsm_par) 396 397 395 398 REAL(wp), DIMENSION(:), ALLOCATABLE :: ddz_soil_center, & !< 1/dz_soil_center 396 399 ddz_soil, & !< 1/dz_soil … … 400 403 401 404 402 405 403 406 REAL(wp), DIMENSION(0:20) :: root_fraction = 9999999.9_wp, & !< (NAMELIST) distribution of root surface area to the individual soil layers 404 407 soil_moisture = 0.0_wp, & !< NAMELIST soil moisture content (m3/m3) … … 406 409 dz_soil = 9999999.9_wp, & !< (NAMELIST) soil layer depths (spacing) 407 410 zs_layer = 9999999.9_wp !< soil layer depths (edge) 408 411 409 412 TYPE(surf_type_lsm), POINTER :: t_soil_h, & !< Soil temperature (K), horizontal surface elements 410 413 t_soil_h_p, & !< Prog. soil temperature (K), horizontal surface elements 411 414 m_soil_h, & !< Soil moisture (m3/m3), horizontal surface elements 412 m_soil_h_p !< Prog. soil moisture (m3/m3), horizontal surface elements 415 m_soil_h_p !< Prog. soil moisture (m3/m3), horizontal surface elements 413 416 414 417 TYPE(surf_type_lsm), TARGET :: t_soil_h_1, & !< … … 421 424 t_soil_v_p, & !< Prog. soil temperature (K), vertical surface elements 422 425 m_soil_v, & !< Soil moisture (m3/m3), vertical surface elements 423 m_soil_v_p !< Prog. soil moisture (m3/m3), vertical surface elements 426 m_soil_v_p !< Prog. soil moisture (m3/m3), vertical surface elements 424 427 425 428 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET ::& … … 429 432 m_soil_v_2 !< 430 433 431 TYPE(surf_type_lsm), POINTER :: t_surface_h, & !< surface temperature (K), horizontal surface elements 432 t_surface_h_p, & !< progn. surface temperature (K), horizontal surface elements 433 m_liq_h, & !< liquid water reservoir (m), horizontal surface elements 434 m_liq_h_p !< progn. liquid water reservoir (m), horizontal surface elements 434 TYPE(surf_type_lsm), POINTER :: t_surface_h, & !< surface temperature (K), horizontal surface elements 435 t_surface_h_p, & !< progn. surface temperature (K), horizontal surface elements 436 m_liq_h, & !< liquid water reservoir (m), horizontal surface elements 437 m_liq_h_p !< progn. liquid water reservoir (m), horizontal surface elements 435 438 436 439 TYPE(surf_type_lsm), TARGET :: t_surface_h_1, & !< … … 440 443 441 444 TYPE(surf_type_lsm), DIMENSION(:), POINTER :: & 442 t_surface_v, & !< surface temperature (K), vertical surface elements 443 t_surface_v_p, & !< progn. surface temperature (K), vertical surface elements 444 m_liq_v, & !< liquid water reservoir (m), vertical surface elements 445 m_liq_v_p !< progn. liquid water reservoir (m), vertical surface elements 445 t_surface_v, & !< surface temperature (K), vertical surface elements 446 t_surface_v_p, & !< progn. surface temperature (K), vertical surface elements 447 m_liq_v, & !< liquid water reservoir (m), vertical surface elements 448 m_liq_v_p !< progn. liquid water reservoir (m), vertical surface elements 446 449 447 450 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: & … … 456 459 m_soil_av !< Average of m_soil 457 460 458 TYPE(surf_type_lsm), TARGET :: tm_liq_h_m !< liquid water reservoir tendency (m), horizontal surface elements 459 TYPE(surf_type_lsm), TARGET :: tt_surface_h_m !< surface temperature tendency (K), horizontal surface elements 460 TYPE(surf_type_lsm), TARGET :: tt_soil_h_m !< t_soil storage array, horizontal surface elements 461 TYPE(surf_type_lsm), TARGET :: tm_soil_h_m !< m_soil storage array, horizontal surface elements 462 463 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tm_liq_v_m !< liquid water reservoir tendency (m), vertical surface elements 464 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tt_surface_v_m !< surface temperature tendency (K), vertical surface elements 465 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tt_soil_v_m !< t_soil storage array, vertical surface elements 466 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tm_soil_v_m !< m_soil storage array, vertical surface elements 467 468 ! 469 !-- Energy balance variables 461 TYPE(surf_type_lsm), TARGET :: tm_liq_h_m !< liquid water reservoir tendency (m), horizontal surface elements 462 TYPE(surf_type_lsm), TARGET :: tt_surface_h_m !< surface temperature tendency (K), horizontal surface elements 463 TYPE(surf_type_lsm), TARGET :: tt_soil_h_m !< t_soil storage array, horizontal surface elements 464 TYPE(surf_type_lsm), TARGET :: tm_soil_h_m !< m_soil storage array, horizontal surface elements 465 466 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tm_liq_v_m !< liquid water reservoir tendency (m), vertical surface elements 467 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tt_surface_v_m !< surface temperature tendency (K), vertical surface elements 468 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tt_soil_v_m !< t_soil storage array, vertical surface elements 469 TYPE(surf_type_lsm), DIMENSION(0:3), TARGET :: tm_soil_v_m !< m_soil storage array, vertical surface elements 470 471 ! 472 !-- Energy balance variables 470 473 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: & 471 474 c_liq_av, & !< average of c_liq 472 475 c_soil_av, & !< average of c_soil 473 476 c_veg_av, & !< average of c_veg 474 lai_av, & !< average of lai 477 lai_av, & !< average of lai 475 478 qsws_liq_av, & !< average of qsws_liq 476 479 qsws_soil_av, & !< average of qsws_soil 477 480 qsws_veg_av, & !< average of qsws_veg 478 481 r_s_av !< average of r_s 479 482 480 483 ! 481 484 !-- Predefined Land surface classes (vegetation_type) 482 485 CHARACTER(26), DIMENSION(0:18), PARAMETER :: vegetation_type_name = (/ & 483 'user defined ', & ! 0 484 'bare soil ', & ! 1 486 'user defined ', & ! 0 487 'bare soil ', & ! 1 485 488 'crops, mixed farming ', & ! 2 486 489 'short grass ', & ! 3 … … 505 508 !-- Soil model classes (soil_type) 506 509 CHARACTER(12), DIMENSION(0:6), PARAMETER :: soil_type_name = (/ & 507 'user defined', & ! 0 510 'user defined', & ! 0 508 511 'coarse ', & ! 1 509 512 'medium ', & ! 2 … … 517 520 !-- Pavement classes 518 521 CHARACTER(29), DIMENSION(0:15), PARAMETER :: pavement_type_name = (/ & 519 'user defined ', & ! 0 522 'user defined ', & ! 0 520 523 'asphalt/concrete mix ', & ! 1 521 524 'asphalt (asphalt concrete) ', & ! 2 … … 533 536 'artifical turf (sports) ', & ! 14 534 537 'clay (sports) ' & ! 15 535 /) 536 538 /) 539 537 540 ! 538 541 !-- Water classes 539 542 CHARACTER(12), DIMENSION(0:5), PARAMETER :: water_type_name = (/ & 540 'user defined', & ! 0 543 'user defined', & ! 0 541 544 'lake ', & ! 1 542 545 'river ', & ! 2 … … 544 547 'pond ', & ! 4 545 548 'fountain ' & ! 5 546 /) 547 549 /) 550 548 551 ! 549 552 !-- Land surface parameters according to the respective classes (vegetation_type) … … 599 602 /), (/ 12, 18 /) ) 600 603 601 604 602 605 ! 603 606 !-- Root distribution for default soil layer configuration (sum = 1) … … 618 621 0.00_wp, 0.00_wp, 0.00_wp, 0.00_wp, & ! 13 619 622 0.25_wp, 0.34_wp, 0.27_wp, 0.11_wp, & ! 14 620 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 15 621 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 16 623 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 15 624 0.23_wp, 0.36_wp, 0.30_wp, 0.11_wp, & ! 16 622 625 0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp, & ! 17 623 626 0.19_wp, 0.35_wp, 0.36_wp, 0.10_wp & ! 18 … … 628 631 629 632 ! 630 !-- Soil parameters alpha_vg, l_vg, n_vg, gamma_w_sat, m_sat, m_fc, m_wilt, m_res 633 !-- Soil parameters alpha_vg, l_vg, n_vg, gamma_w_sat, m_sat, m_fc, m_wilt, m_res 631 634 REAL(wp), DIMENSION(0:7,1:6), PARAMETER :: soil_pars = RESHAPE( (/ & 632 635 3.83_wp, 1.250_wp, 1.38_wp, 6.94E-6_wp, 0.403_wp, 0.244_wp, 0.059_wp, 0.025_wp,& ! 1 … … 641 644 ! 642 645 !-- TO BE FILLED 643 !-- Pavement parameters z0, z0h, albedo_type, emissivity 646 !-- Pavement parameters z0, z0h, albedo_type, emissivity 644 647 REAL(wp), DIMENSION(0:3,1:15), PARAMETER :: pavement_pars = RESHAPE( (/ & 645 648 5.0E-2_wp, 5.0E-4_wp, 18.0_wp, 0.97_wp, & ! 1 646 649 5.0E-2_wp, 5.0E-4_wp, 19.0_wp, 0.94_wp, & ! 2 647 1.0E-2_wp, 1.0E-4_wp, 20.0_wp, 0.98_wp, & ! 3 650 1.0E-2_wp, 1.0E-4_wp, 20.0_wp, 0.98_wp, & ! 3 648 651 1.0E-2_wp, 1.0E-4_wp, 21.0_wp, 0.93_wp, & ! 4 649 652 1.0E-2_wp, 1.0E-4_wp, 22.0_wp, 0.97_wp, & ! 5 … … 651 654 1.0E-2_wp, 1.0E-4_wp, 24.0_wp, 0.97_wp, & ! 7 652 655 1.0E-2_wp, 1.0E-4_wp, 25.0_wp, 0.94_wp, & ! 8 653 1.0E-2_wp, 1.0E-4_wp, 26.0_wp, 0.98_wp, & ! 9 656 1.0E-2_wp, 1.0E-4_wp, 26.0_wp, 0.98_wp, & ! 9 654 657 1.0E-2_wp, 1.0E-4_wp, 27.0_wp, 0.93_wp, & ! 10 655 658 1.0E-2_wp, 1.0E-4_wp, 28.0_wp, 0.97_wp, & ! 11 … … 658 661 1.0E-2_wp, 1.0E-4_wp, 31.0_wp, 0.94_wp, & ! 14 659 662 1.0E-2_wp, 1.0E-4_wp, 32.0_wp, 0.98_wp & ! 15 660 /), (/ 4, 15 /) ) 663 /), (/ 4, 15 /) ) 661 664 ! 662 665 !-- Pavement subsurface parameters part 1: thermal conductivity (W/m/K) … … 700 703 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 1.94E6_wp, 9999999.9_wp, 9999999.9_wp & ! 15 701 704 /), (/ 8, 15 /) ) 702 705 703 706 ! 704 707 !-- TO BE FILLED … … 710 713 283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp, & ! 4 711 714 283.0_wp, 0.01_wp, 0.001_wp, 1.0E10_wp, 1.0E10_wp, 1.0_wp, 0.99_wp & ! 5 712 /), (/ 7, 5 /) ) 713 715 /), (/ 7, 5 /) ) 716 714 717 SAVE 715 718 … … 717 720 PRIVATE 718 721 719 722 720 723 ! 721 724 !-- Public functions 722 725 PUBLIC lsm_boundary_condition, lsm_check_data_output, & 723 726 lsm_check_data_output_pr, & 724 lsm_check_parameters, lsm_define_netcdf_grid, lsm_3d_data_averaging,& 727 lsm_check_parameters, lsm_define_netcdf_grid, lsm_3d_data_averaging,& 725 728 lsm_data_output_2d, lsm_data_output_3d, lsm_energy_balance, & 726 729 lsm_header, lsm_init, lsm_init_arrays, lsm_parin, lsm_soil_model, & … … 745 748 MODULE PROCEDURE lsm_check_data_output 746 749 END INTERFACE lsm_check_data_output 747 750 748 751 INTERFACE lsm_check_data_output_pr 749 752 MODULE PROCEDURE lsm_check_data_output_pr 750 753 END INTERFACE lsm_check_data_output_pr 751 754 752 755 INTERFACE lsm_check_parameters 753 756 MODULE PROCEDURE lsm_check_parameters 754 757 END INTERFACE lsm_check_parameters 755 758 756 759 INTERFACE lsm_3d_data_averaging 757 760 MODULE PROCEDURE lsm_3d_data_averaging … … 777 780 MODULE PROCEDURE lsm_header 778 781 END INTERFACE lsm_header 779 782 780 783 INTERFACE lsm_init 781 784 MODULE PROCEDURE lsm_init … … 785 788 MODULE PROCEDURE lsm_init_arrays 786 789 END INTERFACE lsm_init_arrays 787 790 788 791 INTERFACE lsm_parin 789 792 MODULE PROCEDURE lsm_parin 790 793 END INTERFACE lsm_parin 791 794 792 795 INTERFACE lsm_soil_model 793 796 MODULE PROCEDURE lsm_soil_model … … 812 815 ! Description: 813 816 ! ------------ 814 !> Set internal Neumann boundary condition at outer soil grid points 815 !> for temperature and humidity. 817 !> Set internal Neumann boundary condition at outer soil grid points 818 !> for temperature and humidity. 816 819 !------------------------------------------------------------------------------! 817 820 SUBROUTINE lsm_boundary_condition 818 821 819 822 IMPLICIT NONE 820 823 … … 879 882 !------------------------------------------------------------------------------! 880 883 SUBROUTINE lsm_check_data_output( var, unit, i, ilen, k ) 881 882 884 885 883 886 USE control_parameters, & 884 887 ONLY: data_output, message_string … … 886 889 IMPLICIT NONE 887 890 888 CHARACTER (LEN=*) :: unit !< 891 CHARACTER (LEN=*) :: unit !< 889 892 CHARACTER (LEN=*) :: var !< 890 893 891 894 INTEGER(iwp) :: i 892 INTEGER(iwp) :: ilen 895 INTEGER(iwp) :: ilen 893 896 INTEGER(iwp) :: k 894 897 … … 902 905 ENDIF 903 906 unit = 'm3/m3' 904 907 905 908 CASE ( 't_soil' ) 906 909 IF ( .NOT. land_surface ) THEN … … 909 912 CALL message( 'lsm_check_data_output', 'PA0404', 1, 2, 0, 6, 0 ) 910 913 ENDIF 911 unit = 'K' 912 914 unit = 'K' 915 913 916 CASE ( 'lai*', 'c_liq*', 'c_soil*', 'c_veg*', 'm_liq*', & 914 917 'qsws_liq*', 'qsws_soil*', 'qsws_veg*', 'r_s*' ) … … 969 972 ENDIF 970 973 971 IF ( TRIM( var ) == 'lai*' ) unit = 'none' 974 IF ( TRIM( var ) == 'lai*' ) unit = 'none' 972 975 IF ( TRIM( var ) == 'c_liq*' ) unit = 'none' 973 976 IF ( TRIM( var ) == 'c_soil*') unit = 'none' … … 977 980 IF ( TRIM( var ) == 'qsws_soil*' ) unit = 'W/m2' 978 981 IF ( TRIM( var ) == 'qsws_veg*' ) unit = 'W/m2' 979 IF ( TRIM( var ) == 'r_s*') unit = 's/m' 980 982 IF ( TRIM( var ) == 'r_s*') unit = 's/m' 983 981 984 CASE DEFAULT 982 985 unit = 'illegal' … … 995 998 !------------------------------------------------------------------------------! 996 999 SUBROUTINE lsm_check_data_output_pr( variable, var_count, unit, dopr_unit ) 997 1000 998 1001 USE control_parameters, & 999 1002 ONLY: data_output_pr, message_string … … 1006 1009 1007 1010 IMPLICIT NONE 1008 1009 CHARACTER (LEN=*) :: unit !< 1010 CHARACTER (LEN=*) :: variable !< 1011 1012 CHARACTER (LEN=*) :: unit !< 1013 CHARACTER (LEN=*) :: variable !< 1011 1014 CHARACTER (LEN=*) :: dopr_unit !< local value of dopr_unit 1012 1013 INTEGER(iwp) :: var_count !< 1015 1016 INTEGER(iwp) :: var_count !< 1014 1017 1015 1018 SELECT CASE ( TRIM( variable ) ) 1016 1019 1017 1020 CASE ( 't_soil', '#t_soil' ) 1018 1021 IF ( .NOT. land_surface ) THEN … … 1059 1062 1060 1063 END SUBROUTINE lsm_check_data_output_pr 1061 1062 1064 1065 1063 1066 !------------------------------------------------------------------------------! 1064 1067 ! Description: … … 1070 1073 USE control_parameters, & 1071 1074 ONLY: bc_pt_b, bc_q_b, constant_flux_layer, message_string 1072 1073 1075 1076 1074 1077 IMPLICIT NONE 1075 1078 … … 1077 1080 INTEGER(iwp) :: j !< running index, y-dimension 1078 1081 INTEGER(iwp) :: k !< running index, z-dimension 1079 1082 1080 1083 LOGICAL :: dynamic_soil_input_parent !< flag indicating the presence of a dynamic input file for the parent 1081 1084 … … 1086 1089 TRIM( surface_type ) /= 'pavement' .AND. & 1087 1090 TRIM( surface_type ) /= 'water' .AND. & 1088 TRIM( surface_type ) /= 'netcdf' ) THEN 1091 TRIM( surface_type ) /= 'netcdf' ) THEN 1089 1092 message_string = 'unknown surface type: surface_type = "' // & 1090 1093 TRIM( surface_type ) // '"' … … 1108 1111 CALL message( 'lsm_check_parameters', 'PA0400', 1, 2, 0, 6, 0 ) 1109 1112 ENDIF 1110 1113 1111 1114 IF ( .NOT. radiation ) THEN 1112 1115 message_string = 'lsm requires '// & … … 1142 1145 ENDIF 1143 1146 ! 1144 !-- Check if vegetation types are set within a valid range. 1147 !-- Check if vegetation types are set within a valid range. 1145 1148 IF ( TRIM( surface_type ) == 'vegetation' ) THEN 1146 1149 IF ( vegetation_type < LBOUND( vegetation_pars, 2 ) .AND. & … … 1162 1165 'the valid range at (j,i) = ', j, i 1163 1166 CALL message( 'lsm_check_parameters', 'PA0526', & 1164 2, 2, myid, 6, 0 ) 1167 2, 2, myid, 6, 0 ) 1165 1168 ENDIF 1166 1169 ENDDO … … 1169 1172 ENDIF 1170 1173 ! 1171 !-- Check if pavement types are set within a valid range. 1174 !-- Check if pavement types are set within a valid range. 1172 1175 IF ( TRIM( surface_type ) == 'pavement' ) THEN 1173 1176 IF ( pavement_type < LBOUND( pavement_pars, 2 ) .AND. & … … 1188 1191 'the valid range at (j,i) = ', j, i 1189 1192 CALL message( 'lsm_check_parameters', 'PA0527', & 1190 2, 2, myid, 6, 0 ) 1193 2, 2, myid, 6, 0 ) 1191 1194 ENDIF 1192 1195 ENDDO … … 1195 1198 ENDIF 1196 1199 ! 1197 !-- Check if water types are set within a valid range. 1200 !-- Check if water types are set within a valid range. 1198 1201 IF ( TRIM( surface_type ) == 'water' ) THEN 1199 1202 IF ( water_type < LBOUND( water_pars, 2 ) .AND. & … … 1214 1217 'the valid range at (j,i) = ', j, i 1215 1218 CALL message( 'lsm_check_parameters', 'PA0528', & 1216 2, 2, myid, 6, 0 ) 1219 2, 2, myid, 6, 0 ) 1217 1220 ENDIF 1218 1221 ENDDO … … 1223 1226 !-- Check further settings for consistency. 1224 1227 IF ( TRIM( surface_type ) == 'vegetation' ) THEN 1225 1228 1226 1229 IF ( vegetation_type == 0 ) THEN 1227 1230 IF ( min_canopy_resistance == 9999999.9_wp ) THEN … … 1297 1300 ENDIF 1298 1301 ENDIF 1299 1302 1300 1303 ENDIF 1301 1304 1302 1305 IF ( TRIM( surface_type ) == 'water' ) THEN 1303 1306 1304 IF ( water_type == 0 ) THEN 1305 1307 IF ( water_type == 0 ) THEN 1308 1306 1309 IF ( z0_water == 9999999.9_wp ) THEN 1307 1310 message_string = 'water_type = 0 (user_defined)'// & … … 1317 1320 CALL message( 'lsm_check_parameters', 'PA0392', 1, 2, 0, 6, 0 ) 1318 1321 ENDIF 1319 1322 1320 1323 IF ( water_temperature == 9999999.9_wp ) THEN 1321 1324 message_string = 'water_type = 0 (user_defined)'// & … … 1323 1326 '/= 9999999.9' 1324 1327 CALL message( 'lsm_check_parameters', 'PA0379', 1, 2, 0, 6, 0 ) 1325 ENDIF 1326 1328 ENDIF 1329 1327 1330 ENDIF 1328 1331 1329 1332 ENDIF 1330 1333 1331 1334 IF ( TRIM( surface_type ) == 'pavement' ) THEN 1332 1335 … … 1337 1340 ENDIF 1338 1341 1339 IF ( pavement_type == 0 ) THEN 1340 1342 IF ( pavement_type == 0 ) THEN 1343 1341 1344 IF ( z0_pavement == 9999999.9_wp ) THEN 1342 1345 message_string = 'pavement_type = 0 (user_defined)'// & … … 1345 1348 CALL message( 'lsm_check_parameters', 'PA0352', 1, 2, 0, 6, 0 ) 1346 1349 ENDIF 1347 1350 1348 1351 IF ( z0h_pavement == 9999999.9_wp ) THEN 1349 1352 message_string = 'pavement_type = 0 (user_defined)'// & … … 1352 1355 CALL message( 'lsm_check_parameters', 'PA0353', 1, 2, 0, 6, 0 ) 1353 1356 ENDIF 1354 1357 1355 1358 IF ( pavement_heat_conduct == 9999999.9_wp ) THEN 1356 1359 message_string = 'pavement_type = 0 (user_defined)'// & … … 1358 1361 '/= 9999999.9' 1359 1362 CALL message( 'lsm_check_parameters', 'PA0342', 1, 2, 0, 6, 0 ) 1360 ENDIF 1361 1363 ENDIF 1364 1362 1365 IF ( pavement_heat_capacity == 9999999.9_wp ) THEN 1363 1366 message_string = 'pavement_type = 0 (user_defined)'// & … … 1365 1368 '/= 9999999.9' 1366 1369 CALL message( 'lsm_check_parameters', 'PA0139', 1, 2, 0, 6, 0 ) 1367 ENDIF 1370 ENDIF 1368 1371 1369 1372 IF ( pavement_depth_level == 0 ) THEN … … 1372 1375 '/= 0' 1373 1376 CALL message( 'lsm_check_parameters', 'PA0474', 1, 2, 0, 6, 0 ) 1374 ENDIF 1375 1376 ENDIF 1377 1377 ENDIF 1378 1379 ENDIF 1380 1378 1381 ENDIF 1379 1382 1380 1383 IF ( TRIM( surface_type ) == 'netcdf' ) THEN 1381 ! 1382 !-- MS: Some problme here, after calling message everythings stucks at 1383 !-- MPI_FINALIZE call. 1384 IF ( ANY( pavement_type_f%var /= pavement_type_f%fill ) .AND. & 1385 ANY( dz_soil /= 9999999.9_wp ) ) THEN 1386 message_string = 'pavement-surfaces are not allowed in ' // & 1387 'combination with a non-default setting of dz_soil' 1388 CALL message( 'lsm_check_parameters', 'PA0316', 2, 2, 0, 6, 0 ) 1384 IF ( pavement_type_f%from_file ) THEN 1385 IF ( ANY( pavement_type_f%var /= pavement_type_f%fill ) .AND. & 1386 ANY( dz_soil /= 9999999.9_wp ) ) THEN 1387 message_string = 'pavement-surfaces are not allowed in ' // & 1388 'combination with a non-default setting of dz_soil' 1389 CALL message( 'lsm_check_parameters', 'PA0316', 2, 2, 0, 6, 0 ) 1390 ENDIF 1389 1391 ENDIF 1390 1392 ENDIF 1391 1393 1392 1394 ! 1393 1395 !-- Temporary message as long as NetCDF input is not available … … 1457 1459 1458 1460 ENDIF 1459 1460 1461 !!! these checks are not needed for water surfaces??1462 1461 1463 1462 ! … … 1474 1473 nzt_soil = nzt_soil + 1 1475 1474 ENDIF 1476 ENDDO 1475 ENDDO 1477 1476 ENDIF 1478 1477 nzs = nzt_soil + 1 1479 1478 1480 1479 ! 1481 !-- Check whether valid soil temperatures are prescribed. Only check this if 1480 !-- Check whether valid soil temperatures are prescribed. Only check this if 1482 1481 !-- no dynamic soil is not initialized with dynamic input. 1483 !-- In a nested case, check whether there is a dynamic input file for the 1482 !-- In a nested case, check whether there is a dynamic input file for the 1484 1483 !-- child (input_pids_dynamic = .T.) or one for the parent (inquire without 1485 !-- coupling_char. 1484 !-- coupling_char. 1486 1485 INQUIRE( FILE = TRIM( input_file_dynamic ), & 1487 1486 EXIST = dynamic_soil_input_parent ) … … 1518 1517 ! 1519 1518 !-- Calculate grid spacings. Temperature and moisture are defined at 1520 !-- the center of the soil layers, whereas gradients/fluxes are 1519 !-- the center of the soil layers, whereas gradients/fluxes are 1521 1520 !-- defined at the edges (_layer) 1522 1521 ! … … 1538 1537 dz_soil(nzt_soil+1) = zs_layer(nzt_soil) + dz_soil(nzt_soil) 1539 1538 zs(nzt_soil+1) = zs_layer(nzt_soil) + 0.5_wp * dz_soil(nzt_soil) 1540 1539 1541 1540 DO k = nzb_soil, nzt_soil-1 1542 1541 dz_soil_center(k) = zs(k+1) - zs(k) … … 1545 1544 '(dz_soil_center(k) <= 0.0)' 1546 1545 CALL message( 'lsm_check_parameters', 'PA0140', 1, 2, 0, 6, 0 ) 1547 ENDIF 1546 ENDIF 1548 1547 ENDDO 1549 1548 1550 1549 dz_soil_center(nzt_soil) = zs_layer(k-1) + dz_soil(k) - zs(nzt_soil) 1551 1550 1552 1551 ddz_soil_center = 1.0_wp / dz_soil_center 1553 1552 ddz_soil(nzb_soil:nzt_soil) = 1.0_wp / dz_soil(nzb_soil:nzt_soil) … … 1556 1555 1557 1556 END SUBROUTINE lsm_check_parameters 1558 1557 1559 1558 !------------------------------------------------------------------------------! 1560 1559 ! Description: … … 1645 1644 1646 1645 ! 1647 !-- Index offset of surface element point with respect to adjoining 1648 !-- atmospheric grid point 1646 !-- Index offset of surface element point with respect to adjoining 1647 !-- atmospheric grid point 1649 1648 k_off = surf%koff 1650 1649 j_off = surf%joff … … 1658 1657 DO m = 1, surf%ns 1659 1658 1660 i = surf%i(m) 1659 i = surf%i(m) 1661 1660 j = surf%j(m) 1662 1661 k = surf%k(m) … … 1667 1666 !-- parameterization uses a combination of two conductivities: a constant 1668 1667 !-- conductivity for the skin layer, and a conductivity according to the 1669 !-- uppermost soil layer. For bare soil and pavements, no skin layer is 1670 !-- applied. In these cases, the temperature is assumed to be constant 1671 !-- between the surface and the first soil layer. The heat conductivity is 1672 !-- then derived from the soil/pavement properties. 1668 !-- uppermost soil layer. For bare soil and pavements, no skin layer is 1669 !-- applied. In these cases, the temperature is assumed to be constant 1670 !-- between the surface and the first soil layer. The heat conductivity is 1671 !-- then derived from the soil/pavement properties. 1673 1672 !-- For water surfaces, the conductivity is already set to 1E10. 1674 1673 !-- Moreover, the heat capacity is set. For bare soil the heat capacity is … … 1684 1683 lambda_h_sat = lambda_h_sm**(1.0_wp - surf%m_sat(nzb_soil,m)) * & 1685 1684 lambda_h_water ** surf_m_soil%var_2d(nzb_soil,m) 1686 1685 1687 1686 ke = 1.0_wp + LOG10( MAX( 0.1_wp, surf_m_soil%var_2d(nzb_soil,m) / & 1688 surf%m_sat(nzb_soil,m) ) ) 1689 1687 surf%m_sat(nzb_soil,m) ) ) 1688 1690 1689 lambda_soil = (ke * (lambda_h_sat - lambda_h_dry) + lambda_h_dry ) & 1691 1690 * ddz_soil(nzb_soil) * 2.0_wp … … 1695 1694 !-- a heat capacity is that of the soil layer, otherwise it is a 1696 1695 !-- combination of the conductivities from the skin and the soil layer 1697 IF ( surf%lambda_surface_s(m) == 0.0_wp ) THEN 1696 IF ( surf%lambda_surface_s(m) == 0.0_wp ) THEN 1698 1697 surf%c_surface(m) = (rho_c_soil * (1.0_wp - surf%m_sat(nzb_soil,m))& 1699 1698 + rho_c_water * surf_m_soil%var_2d(nzb_soil,m) ) & 1700 * dz_soil(nzb_soil) * 0.5_wp 1699 * dz_soil(nzb_soil) * 0.5_wp 1701 1700 lambda_surface = lambda_soil 1702 1701 … … 1717 1716 !-- Set heat capacity of the skin/surface. It is ususally zero when a skin 1718 1717 !-- layer is used, and non-zero otherwise. 1719 c_surface_tmp = surf%c_surface(m) 1718 c_surface_tmp = surf%c_surface(m) 1720 1719 1721 1720 ! … … 1729 1728 ! ELSEIF ( cloud_droplets ) THEN 1730 1729 ! pt1 = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i) 1731 ! qv1 = q(k,j,i) 1730 ! qv1 = q(k,j,i) 1732 1731 ! ELSE 1733 1732 ! pt1 = pt(k,j,i) … … 1743 1742 !-- heat transfer coefficient for forced convection along vertical walls 1744 1743 !-- follows formulation in TUF3d model (Krayenhoff & Voogt, 2006) 1745 !-- 1744 !-- 1746 1745 !-- H = httc (Tsfc - Tair) 1747 1746 !-- httc = rw * (11.8 + 4.2 * Ueff) - 4.0 1748 !-- 1747 !-- 1749 1748 !-- rw: wall patch roughness relative to 1.0 for concrete 1750 1749 !-- Ueff: effective wind speed 1751 1750 !-- - 4.0 is a reduction of Rowley et al (1930) formulation based on 1752 1751 !-- Cole and Sturrock (1977) 1753 !-- 1752 !-- 1754 1753 !-- Ucan: Canyon wind speed 1755 1754 !-- wstar: convective velocity … … 1757 1756 !-- zH: height of the convective layer 1758 1757 !-- wstar = (g/Tcan*Qs*zH)**(1./3.) 1759 1760 !-- Effective velocity components must always 1761 !-- be defined at scalar grid point. The wall normal component is 1758 1759 !-- Effective velocity components must always 1760 !-- be defined at scalar grid point. The wall normal component is 1762 1761 !-- obtained by simple linear interpolation. ( An alternative would 1763 1762 !-- be an logarithmic interpolation. ) … … 1765 1764 !-- 1000 is used in the nominator for scaling) 1766 1765 !-- To do: detailed investigation which approach gives more reliable results! 1767 !-- Please note, in case of very small friction velocity, e.g. in little 1768 !-- holes, the resistance can become negative. For this reason, limit r_a 1769 !-- to positive values. 1766 !-- Please note, in case of very small friction velocity, e.g. in little 1767 !-- holes, the resistance can become negative. For this reason, limit r_a 1768 !-- to positive values. 1770 1769 IF ( horizontal .OR. .NOT. aero_resist_kray ) THEN 1771 1770 surf%r_a(m) = ABS( ( surf%pt1(m) - surf%pt_surface(m) ) / & … … 1778 1777 ( ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp )**2, & 1779 1778 0.01_wp ) ) & 1780 ) - 4.0_wp ) 1779 ) - 4.0_wp ) 1781 1780 ENDIF 1782 1781 ! 1783 !-- Make sure that the resistance does not drop to zero for neutral 1782 !-- Make sure that the resistance does not drop to zero for neutral 1784 1783 !-- stratification. Also, set a maximum resistance to avoid the breakdown of 1785 1784 !-- MOST for locations with zero wind speed 1786 1785 IF ( surf%r_a(m) < 1.0_wp ) surf%r_a(m) = 1.0_wp 1787 IF ( surf%r_a(m) > 300.0_wp ) surf%r_a(m) = 300.0_wp 1786 IF ( surf%r_a(m) > 300.0_wp ) surf%r_a(m) = 300.0_wp 1788 1787 ! 1789 1788 !-- Second step: calculate canopy resistance r_canopy 1790 1789 !-- f1-f3 here are defined as 1/f1-f3 as in ECMWF documentation 1791 1792 !-- f1: correction for incoming shortwave radiation (stomata close at 1790 1791 !-- f1: correction for incoming shortwave radiation (stomata close at 1793 1792 !-- night) 1794 1793 f1 = MIN( 1.0_wp, ( 0.004_wp * surf%rad_sw_in(m) + 0.05_wp ) / & … … 1797 1796 1798 1797 ! 1799 !-- f2: correction for soil moisture availability to plants (the 1798 !-- f2: correction for soil moisture availability to plants (the 1800 1799 !-- integrated soil moisture must thus be considered here) 1801 1800 !-- f2 = 0 for very dry soils … … 1804 1803 m_total = m_total + surf%root_fr(ks,m) & 1805 1804 * MAX( surf_m_soil%var_2d(ks,m), surf%m_wilt(ks,m) ) 1806 ENDDO 1805 ENDDO 1807 1806 1808 1807 ! … … 1854 1853 1855 1854 surf%r_soil(m) = surf%r_soil_min(m) / f2 1856 1855 1857 1856 ! 1858 1857 !-- Calculate the maximum possible liquid water amount on plants and 1859 1858 !-- bare surface. For vegetated surfaces, a maximum depth of 0.2 mm is 1860 !-- assumed, while paved surfaces might hold up 1 mm of water. The 1861 !-- liquid water fraction for paved surfaces is calculated after 1862 !-- Masson (2000) (TEB model) and originates from Noilhan & Planton (1989), 1859 !-- assumed, while paved surfaces might hold up 1 mm of water. The 1860 !-- liquid water fraction for paved surfaces is calculated after 1861 !-- Masson (2000) (TEB model) and originates from Noilhan & Planton (1989), 1863 1862 !-- while the ECMWF formulation is used for vegetated surfaces and bare soils. 1864 1863 IF ( surf%pavement_surface(m) ) THEN … … 1882 1881 1883 1882 ! 1884 !-- Calculate coefficients for the total evapotranspiration 1883 !-- Calculate coefficients for the total evapotranspiration 1885 1884 !-- In case of water surface, set vegetation and soil fluxes to zero. 1886 1885 !-- For pavements, only evaporation of liquid water is possible. … … 1914 1913 ! 1915 1914 !-- Calculate net radiation radiation without longwave outgoing flux because 1916 !-- it has a dependency on surface temperature and thus enters the prognostic 1915 !-- it has a dependency on surface temperature and thus enters the prognostic 1917 1916 !-- equations directly 1918 1917 surf%rad_net_l(m) = surf%rad_sw_in(m) - surf%rad_sw_out(m) & … … 1953 1952 surf_t_surface_p%var_1d(m) = ( coef_1 * dt_3d * tsc(2) + c_surface_tmp *& 1954 1953 surf_t_surface%var_1d(m) ) / ( c_surface_tmp + coef_2& 1955 * dt_3d * tsc(2) ) 1954 * dt_3d * tsc(2) ) 1956 1955 1957 1956 ! … … 1985 1984 !-- especially when setting skip_time_do_radiation /= 0. The threshold 1986 1985 !-- value of 0.2 used here is just a first guess. This method should be 1987 !-- revised in the future as tests have shown that the threshold is 1986 !-- revised in the future as tests have shown that the threshold is 1988 1987 !-- often reached, when no oscillations would occur (causes immense 1989 1988 !-- computing time for the radiation code). … … 2050 2049 ENDIF 2051 2050 ! 2052 !-- Calculate change in liquid water reservoir due to dew fall or 2051 !-- Calculate change in liquid water reservoir due to dew fall or 2053 2052 !-- evaporation of liquid water 2054 2053 IF ( humidity ) THEN … … 2062 2061 !-- Add precipitation to liquid water reservoir, if possible. 2063 2062 !-- Otherwise, add the water to soil. In case of 2064 !-- pavements, the exceeding water amount is explicitly removed 2063 !-- pavements, the exceeding water amount is explicitly removed 2065 2064 !-- (as fictive runoff by drainage systems) 2066 2065 IF ( surf%pavement_surface(m) ) THEN … … 2070 2069 * hyrho(k+k_off) & 2071 2070 * 0.001_wp * rho_l * l_v 2072 ENDIF 2071 ENDIF 2073 2072 ELSE 2074 2073 IF ( surf_m_liq%var_1d(m) < m_liq_max ) THEN … … 2080 2079 surf%c_veg(m) ) * prr(k+k_off,j+j_off,i+i_off)& 2081 2080 * hyrho(k+k_off) & 2082 * 0.001_wp * rho_l * l_v 2081 * 0.001_wp * rho_l * l_v 2083 2082 ELSE 2084 2083 … … 2101 2100 !-- Check if reservoir is full (avoid values > m_liq_max) 2102 2101 !-- In that case, qsws_liq goes to qsws_soil for pervious surfaces. In 2103 !-- this case qsws_veg is zero anyway (because c_liq = 1), 2102 !-- this case qsws_veg is zero anyway (because c_liq = 1), 2104 2103 !-- so that tend is zero and no further check is needed 2105 2104 IF ( surf_m_liq%var_1d(m) == m_liq_max ) THEN … … 2111 2110 2112 2111 ! 2113 !-- In case qsws_veg becomes negative (unphysical behavior), 2112 !-- In case qsws_veg becomes negative (unphysical behavior), 2114 2113 !-- let the water enter the liquid water reservoir as dew on the 2115 2114 !-- plant … … 2118 2117 surf%qsws_veg(m) = 0.0_wp 2119 2118 ENDIF 2120 ENDIF 2121 2119 ENDIF 2120 2122 2121 surf%qsws(m) = surf%qsws(m) / l_v 2123 2122 2124 2123 tend = - surf%qsws_liq(m) * drho_l_lv 2125 2124 surf_m_liq_p%var_1d(m) = surf_m_liq%var_1d(m) + dt_3d * & … … 2176 2175 !-- Calculate new roughness lengths (for water surfaces only) 2177 2176 IF ( horizontal .AND. .NOT. constant_roughness ) CALL calc_z0_water_surface 2178 2177 2179 2178 IF ( debug_output_timestep ) THEN 2180 2179 WRITE( debug_string, * ) 'lsm_energy_balance', horizontal, l … … 2202 2201 DO m = 1, surf%ns 2203 2202 2204 i = surf%i(m) 2203 i = surf%i(m) 2205 2204 j = surf%j(m) 2206 2205 k = surf%k(m) 2207 2206 ! 2208 2207 !-- Calculate water vapour pressure at saturation and convert to hPa 2209 e_s = 0.01_wp * magnus( MIN(surf_t_surface_p%var_1d(m), 333.15_wp) ) 2208 e_s = 0.01_wp * magnus( MIN(surf_t_surface_p%var_1d(m), 333.15_wp) ) 2210 2209 2211 2210 ! … … 2226 2225 q(k,j,i) 2227 2226 ENDIF 2228 2227 2229 2228 surf%q_surface(m) = q(k+k_off,j+j_off,i+i_off) 2230 2229 ! … … 2233 2232 ( 1.0_wp + 0.61_wp * surf%q_surface(m) ) 2234 2233 2235 2236 2234 2235 2237 2236 ENDDO 2238 2237 !$OMP END PARALLEL 2239 2238 2240 2239 END SUBROUTINE calc_q_surface 2241 2240 2242 2241 END SUBROUTINE lsm_energy_balance 2243 2244 2242 2243 2245 2244 2246 2245 !------------------------------------------------------------------------------! … … 2260 2259 CHARACTER (LEN=86) :: soil_depth_chr !< String for soil depth 2261 2260 CHARACTER (LEN=20) :: coor_chr !< Temporary string 2262 2261 2263 2262 INTEGER(iwp) :: i !< Loop index over soil layers 2264 2263 2265 2264 INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file 2266 2265 2267 2266 t_soil_chr = '' 2268 2267 m_soil_chr = '' 2269 soil_depth_chr = '' 2270 roots_chr = '' 2268 soil_depth_chr = '' 2269 roots_chr = '' 2271 2270 vertical_index_chr = '' 2272 2271 … … 2313 2312 2 FORMAT (' --> Soil bottom is closed (water content is conserved', & 2314 2313 ', default)') 2315 3 FORMAT (' --> Soil bottom is open (water content is not conserved)') 2314 3 FORMAT (' --> Soil bottom is open (water content is not conserved)') 2316 2315 4 FORMAT (' --> Land surface type : ',A,/ & 2317 2316 ' --> Soil porosity type : ',A) … … 2346 2345 ONLY: pmc_is_rootmodel 2347 2346 #endif 2348 2347 2349 2348 USE pmc_interface, & 2350 2349 ONLY: nested_run 2351 2350 2352 2351 IMPLICIT NONE 2353 2352 … … 2362 2361 INTEGER(iwp) :: m !< running index 2363 2362 INTEGER(iwp) :: st !< soil-type index 2364 INTEGER(iwp) :: n_soil_layers_total !< temperature variable, stores the total number of soil layers + 4 2363 INTEGER(iwp) :: n_soil_layers_total !< temperature variable, stores the total number of soil layers + 4 2365 2364 #if defined( __parallel ) 2366 2365 INTEGER(iwp) :: nzs_root !< number of soil layers in root domain (used in case soil data needs to be … … 2374 2373 2375 2374 #if defined( __parallel ) 2376 REAL(wp), DIMENSION(:), ALLOCATABLE :: m_soil_root !< domain-averaged soil moisture profile in root domain 2375 REAL(wp), DIMENSION(:), ALLOCATABLE :: m_soil_root !< domain-averaged soil moisture profile in root domain 2377 2376 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_soil_root !< domain-averaged soil temperature profile in root domain 2378 2377 #endif … … 2467 2466 ALLOCATE ( surf_lsm_h%rho_c_total_def(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ) 2468 2467 ALLOCATE ( surf_lsm_h%root_fr(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ) 2469 2468 2470 2469 surf_lsm_h%lambda_h = 0.0_wp 2471 2470 ! … … 2473 2472 IF ( humidity ) THEN 2474 2473 ALLOCATE ( surf_lsm_h%lambda_w(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ) 2475 ALLOCATE ( surf_lsm_h%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ) 2476 2477 surf_lsm_h%lambda_w = 0.0_wp 2474 ALLOCATE ( surf_lsm_h%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ) 2475 2476 surf_lsm_h%lambda_w = 0.0_wp 2478 2477 ENDIF 2479 2478 ! … … 2490 2489 ALLOCATE ( surf_lsm_v(l)%m_wilt(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2491 2490 ALLOCATE ( surf_lsm_v(l)%n_vg(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2492 ALLOCATE ( surf_lsm_v(l)%rho_c_total(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2493 ALLOCATE ( surf_lsm_v(l)%rho_c_total_def(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2491 ALLOCATE ( surf_lsm_v(l)%rho_c_total(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2492 ALLOCATE ( surf_lsm_v(l)%rho_c_total_def(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2494 2493 ALLOCATE ( surf_lsm_v(l)%root_fr(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2495 2494 2496 surf_lsm_v(l)%lambda_h = 0.0_wp 2497 2495 surf_lsm_v(l)%lambda_h = 0.0_wp 2496 2498 2497 ! 2499 2498 !-- If required, allocate humidity-related variables for the soil model 2500 2499 IF ( humidity ) THEN 2501 2500 ALLOCATE ( surf_lsm_v(l)%lambda_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2502 ALLOCATE ( surf_lsm_v(l)%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2503 2504 surf_lsm_v(l)%lambda_w = 0.0_wp 2505 ENDIF 2501 ALLOCATE ( surf_lsm_v(l)%gamma_w(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 2502 2503 surf_lsm_v(l)%lambda_w = 0.0_wp 2504 ENDIF 2506 2505 ENDDO 2507 2506 ! 2508 !-- Allocate albedo type and emissivity for vegetation, water and pavement 2507 !-- Allocate albedo type and emissivity for vegetation, water and pavement 2509 2508 !-- fraction. 2510 !-- Set default values at each surface element. 2509 !-- Set default values at each surface element. 2511 2510 ALLOCATE ( surf_lsm_h%albedo_type(1:surf_lsm_h%ns,0:2) ) 2512 2511 ALLOCATE ( surf_lsm_h%emissivity(1:surf_lsm_h%ns,0:2) ) 2513 2512 ! 2514 2513 !-- Initialize albedo type according to its default type, in order to set values 2515 !-- independent on default albedo_type in radiation model. 2514 !-- independent on default albedo_type in radiation model. 2516 2515 surf_lsm_h%albedo_type(:,ind_veg_wall) = & 2517 2516 INT( vegetation_pars(ind_v_at,vegetation_type) ) … … 2525 2524 ALLOCATE ( surf_lsm_v(l)%emissivity(1:surf_lsm_v(l)%ns,0:2) ) 2526 2525 ! 2527 !-- Initialize albedo type according to its default type, in order to 2528 !-- set values independent on default albedo_type in radiation model. 2526 !-- Initialize albedo type according to its default type, in order to 2527 !-- set values independent on default albedo_type in radiation model. 2529 2528 surf_lsm_v(l)%albedo_type(:,ind_veg_wall) = & 2530 2529 INT( vegetation_pars(ind_v_at,vegetation_type) ) … … 2536 2535 ENDDO 2537 2536 ! 2538 !-- Allocate arrays for relative surface fraction. 2537 !-- Allocate arrays for relative surface fraction. 2539 2538 !-- 0 - vegetation fraction, 2 - water fraction, 1 - pavement fraction 2540 2539 ALLOCATE( surf_lsm_h%frac(1:surf_lsm_h%ns,0:2) ) … … 2546 2545 ! 2547 2546 !-- For vertical walls only - allocate special flag indicating if any building is on 2548 !-- top of any natural surfaces. Used for initialization only. 2547 !-- top of any natural surfaces. Used for initialization only. 2549 2548 DO l = 0, 3 2550 2549 ALLOCATE( surf_lsm_v(l)%building_covered(1:surf_lsm_v(l)%ns) ) … … 2556 2555 ALLOCATE( surf_lsm_h%vegetation_type(1:surf_lsm_h%ns) ) 2557 2556 ALLOCATE( surf_lsm_h%water_type(1:surf_lsm_h%ns) ) 2558 2557 2559 2558 surf_lsm_h%pavement_type = 0 2560 2559 surf_lsm_h%vegetation_type = 0 2561 2560 surf_lsm_h%water_type = 0 2562 2561 2563 2562 ALLOCATE( surf_lsm_h%pavement_type_name(1:surf_lsm_h%ns) ) 2564 2563 ALLOCATE( surf_lsm_h%vegetation_type_name(1:surf_lsm_h%ns) ) 2565 2564 ALLOCATE( surf_lsm_h%water_type_name(1:surf_lsm_h%ns) ) 2566 2565 2567 2566 surf_lsm_h%pavement_type_name = 'none' 2568 2567 surf_lsm_h%vegetation_type_name = 'none' 2569 2568 surf_lsm_h%water_type_name = 'none' 2570 2569 2571 2570 DO l = 0, 3 2572 2571 ALLOCATE( surf_lsm_v(l)%pavement_type(1:surf_lsm_v(l)%ns) ) 2573 2572 ALLOCATE( surf_lsm_v(l)%vegetation_type(1:surf_lsm_v(l)%ns) ) 2574 2573 ALLOCATE( surf_lsm_v(l)%water_type(1:surf_lsm_v(l)%ns) ) 2575 2574 2576 2575 surf_lsm_v(l)%pavement_type = 0 2577 2576 surf_lsm_v(l)%vegetation_type = 0 2578 2577 surf_lsm_v(l)%water_type = 0 2579 2578 2580 2579 ALLOCATE( surf_lsm_v(l)%pavement_type_name(1:surf_lsm_v(l)%ns) ) 2581 2580 ALLOCATE( surf_lsm_v(l)%vegetation_type_name(1:surf_lsm_v(l)%ns) ) 2582 2581 ALLOCATE( surf_lsm_v(l)%water_type_name(1:surf_lsm_v(l)%ns) ) 2583 2582 2584 2583 surf_lsm_v(l)%pavement_type_name = 'none' 2585 2584 surf_lsm_v(l)%vegetation_type_name = 'none' 2586 surf_lsm_v(l)%water_type_name = 'none' 2585 surf_lsm_v(l)%water_type_name = 'none' 2587 2586 ENDDO 2588 2589 ! 2590 !-- Set flag parameter for the prescribed surface type depending on user 2587 2588 ! 2589 !-- Set flag parameter for the prescribed surface type depending on user 2591 2590 !-- input. Set surface fraction to 1 for the respective type. 2592 2591 SELECT CASE ( TRIM( surface_type ) ) 2593 2592 2594 2593 CASE ( 'vegetation' ) 2595 2594 2596 2595 surf_lsm_h%vegetation_surface = .TRUE. 2597 2596 surf_lsm_h%frac(:,ind_veg_wall) = 1.0_wp … … 2600 2599 surf_lsm_v(l)%frac(:,ind_veg_wall) = 1.0_wp 2601 2600 ENDDO 2602 2601 2603 2602 CASE ( 'water' ) 2604 2603 2605 2604 surf_lsm_h%water_surface = .TRUE. 2606 2605 surf_lsm_h%frac(:,ind_wat_win) = 1.0_wp 2607 2606 ! 2608 2607 !-- Note, vertical water surface does not really make sense. 2609 DO l = 0, 3 2608 DO l = 0, 3 2610 2609 surf_lsm_v(l)%water_surface = .TRUE. 2611 2610 surf_lsm_v(l)%frac(:,ind_wat_win) = 1.0_wp … … 2613 2612 2614 2613 CASE ( 'pavement' ) 2615 2614 2616 2615 surf_lsm_h%pavement_surface = .TRUE. 2617 2616 surf_lsm_h%frac(:,ind_pav_green) = 1.0_wp … … 2644 2643 2, 2, myid, 6, 0 ) 2645 2644 ENDIF 2646 2645 2647 2646 ENDDO 2648 2647 ! 2649 2648 !-- For vertical surfaces some special checks and treatment are 2650 !-- required for correct initialization. 2649 !-- required for correct initialization. 2651 2650 DO l = 0, 3 2652 2651 DO m = 1, surf_lsm_v(l)%ns 2653 2652 ! 2654 !-- Only for vertical surfaces. Check if at the grid point where 2655 !-- the wall is defined (i+ioff, j+joff) is any building. 2653 !-- Only for vertical surfaces. Check if at the grid point where 2654 !-- the wall is defined (i+ioff, j+joff) is any building. 2656 2655 !-- This case, no natural surfaces properties will be defined at 2657 2656 !-- at this grid point, leading to problems in the initialization. 2658 2657 !-- To overcome this, define a special flag which 2659 !-- indicates that a building is defined at the wall grid point 2660 !-- and take the surface properties from the adjoining grid 2658 !-- indicates that a building is defined at the wall grid point 2659 !-- and take the surface properties from the adjoining grid 2661 2660 !-- point, i.e. without offset values. 2662 2661 !-- Further, there can occur a special case where elevation 2663 2662 !-- changes are larger than building heights. This case, (j,i) 2664 !-- and (j+joff,i+ioff) grid points may be both covered by 2665 !-- buildings, but vertical, but vertically natural walls may 2666 !-- be located between the buildings. This case, it is not 2667 !-- guaranteed that information about natural surface types is 2668 !-- given, neither at (j,i) nor at (j+joff,i+ioff), again leading 2669 !-- to non-initialized surface properties. 2663 !-- and (j+joff,i+ioff) grid points may be both covered by 2664 !-- buildings, but vertical, but vertically natural walls may 2665 !-- be located between the buildings. This case, it is not 2666 !-- guaranteed that information about natural surface types is 2667 !-- given, neither at (j,i) nor at (j+joff,i+ioff), again leading 2668 !-- to non-initialized surface properties. 2670 2669 surf_lsm_v(l)%building_covered(m) = .FALSE. 2671 2670 ! 2672 !-- Wall grid point is building-covered. This case, set 2673 !-- flag indicating that surface properties are initialized 2674 !-- from neighboring reference grid point, which is not 2675 !-- building_covered. 2671 !-- Wall grid point is building-covered. This case, set 2672 !-- flag indicating that surface properties are initialized 2673 !-- from neighboring reference grid point, which is not 2674 !-- building_covered. 2676 2675 IF ( building_type_f%from_file ) THEN 2677 2676 i = surf_lsm_v(l)%i(m) … … 2685 2684 !-- point are both building-covered. This case, surface 2686 2685 !-- properties are not necessarily defined (not covered by 2687 !-- checks for static input file) at this surface. Hence, 2688 !-- initialize surface properties by simply setting 2689 !-- vegetation_type_f to bare-soil bulk parametrization. 2690 !-- soil_type_f as well as surface_fractions_f will be set 2691 !-- also. 2686 !-- checks for static input file) at this surface. Hence, 2687 !-- initialize surface properties by simply setting 2688 !-- vegetation_type_f to bare-soil bulk parametrization. 2689 !-- soil_type_f as well as surface_fractions_f will be set 2690 !-- also. 2692 2691 IF ( building_type_f%var(j+surf_lsm_v(l)%joff, & 2693 2692 i+surf_lsm_v(l)%ioff) /= & … … 2696 2695 THEN 2697 2696 vegetation_type_f%var(j,i) = 1 ! bare soil 2698 soil_type_f%var_2d(j,i) = 1 2699 ! 2700 !-- If surface_fraction is provided in static input, 2697 soil_type_f%var_2d(j,i) = 1 2698 ! 2699 !-- If surface_fraction is provided in static input, 2701 2700 !-- set fraction for vegetation to one at building-covered 2702 2701 !-- surfaces. … … 2707 2706 ENDIF 2708 2707 ENDIF 2709 2708 2710 2709 ENDIF 2711 2710 ! … … 2738 2737 END SELECT 2739 2738 ! 2740 !-- In case of netcdf input file, further initialize surface fractions. 2739 !-- In case of netcdf input file, further initialize surface fractions. 2741 2740 !-- At the moment only 1 surface is given at a location, so that the fraction 2742 !-- is either 0 or 1. This will be revised later. If surface fraction 2741 !-- is either 0 or 1. This will be revised later. If surface fraction 2743 2742 !-- is not given in static input file, relative fractions will be derived 2744 2743 !-- from given surface type. In this case, only 1 type is given at a certain 2745 !-- location (already checked). 2744 !-- location (already checked). 2746 2745 IF ( input_pids_static .AND. surface_fraction_f%from_file ) THEN 2747 2746 DO m = 1, surf_lsm_h%ns … … 2773 2772 j, i, ') are all zero.' 2774 2773 CALL message( 'land_surface_model_mod', 'PA0688', & 2775 2, 2, myid, 6, 0 ) 2774 2, 2, myid, 6, 0 ) 2776 2775 ENDIF 2777 2776 ! 2778 2777 !-- In case the sum of all surfaces is not 1, which may happen 2779 2778 !-- due to rounding errors or type conversions, normalize the 2780 !-- fractions to one. Note, at the moment no tile approach is 2779 !-- fractions to one. Note, at the moment no tile approach is 2781 2780 !-- implemented, so that relative fractions are either 1 or zero. 2782 2781 IF ( SUM ( surf_lsm_h%frac(m,:) ) > 1.0_wp .OR. & … … 2791 2790 DO m = 1, surf_lsm_v(l)%ns 2792 2791 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 2793 surf_lsm_v(l)%building_covered(m) ) 2792 surf_lsm_v(l)%building_covered(m) ) 2794 2793 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 2795 surf_lsm_v(l)%building_covered(m) ) 2796 ! 2797 !-- 0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction 2794 surf_lsm_v(l)%building_covered(m) ) 2795 ! 2796 !-- 0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction 2798 2797 IF ( surface_fraction_f%frac(ind_veg_wall,j,i) /= & 2799 2798 surface_fraction_f%fill ) THEN … … 2819 2818 j, i, ') are all zero.' 2820 2819 CALL message( 'land_surface_model_mod', 'PA0688', & 2821 2, 2, myid, 6, 0 ) 2820 2, 2, myid, 6, 0 ) 2822 2821 ENDIF 2823 2822 ! 2824 2823 !-- In case the sum of all surfaces is not 1, which may happen 2825 2824 !-- due to rounding errors or type conversions, normalize the 2826 !-- fractions to one. Note, at the moment no tile approach is 2825 !-- fractions to one. Note, at the moment no tile approach is 2827 2826 !-- implemented, so that relative fractions are either 1 or zero. 2828 2827 IF ( SUM ( surf_lsm_v(l)%frac(m,:) ) > 1.0_wp .OR. & … … 2840 2839 j = surf_lsm_h%j(m) 2841 2840 2842 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & 2841 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & 2843 2842 surf_lsm_h%frac(m,ind_veg_wall) = 1.0_wp 2844 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) & 2845 surf_lsm_h%frac(m,ind_pav_green) = 1.0_wp 2846 IF ( water_type_f%var(j,i) /= water_type_f%fill ) & 2847 surf_lsm_h%frac(m,ind_wat_win) = 1.0_wp 2843 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) & 2844 surf_lsm_h%frac(m,ind_pav_green) = 1.0_wp 2845 IF ( water_type_f%var(j,i) /= water_type_f%fill ) & 2846 surf_lsm_h%frac(m,ind_wat_win) = 1.0_wp 2848 2847 ENDDO 2849 2848 DO l = 0, 3 2850 2849 DO m = 1, surf_lsm_v(l)%ns 2851 2850 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 2852 surf_lsm_v(l)%building_covered(m) ) 2851 surf_lsm_v(l)%building_covered(m) ) 2853 2852 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 2854 surf_lsm_v(l)%building_covered(m) ) 2855 2856 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & 2853 surf_lsm_v(l)%building_covered(m) ) 2854 2855 IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill ) & 2857 2856 surf_lsm_v(l)%frac(m,ind_veg_wall) = 1.0_wp 2858 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) & 2859 surf_lsm_v(l)%frac(m,ind_pav_green) = 1.0_wp 2860 IF ( water_type_f%var(j,i) /= water_type_f%fill ) & 2861 surf_lsm_v(l)%frac(m,ind_wat_win) = 1.0_wp 2857 IF ( pavement_type_f%var(j,i) /= pavement_type_f%fill ) & 2858 surf_lsm_v(l)%frac(m,ind_pav_green) = 1.0_wp 2859 IF ( water_type_f%var(j,i) /= water_type_f%fill ) & 2860 surf_lsm_v(l)%frac(m,ind_wat_win) = 1.0_wp 2862 2861 ENDDO 2863 2862 ENDDO … … 2865 2864 ! 2866 2865 !-- Level 1, initialization of soil parameters. 2867 !-- It is possible to overwrite each parameter by setting the respecticy 2868 !-- NAMELIST variable to a value /= 9999999.9. 2869 IF ( soil_type /= 0 ) THEN 2870 2866 !-- It is possible to overwrite each parameter by setting the respecticy 2867 !-- NAMELIST variable to a value /= 9999999.9. 2868 IF ( soil_type /= 0 ) THEN 2869 2871 2870 IF ( alpha_vangenuchten == 9999999.9_wp ) THEN 2872 2871 alpha_vangenuchten = soil_pars(0,soil_type) … … 2878 2877 2879 2878 IF ( n_vangenuchten == 9999999.9_wp ) THEN 2880 n_vangenuchten = soil_pars(2,soil_type) 2879 n_vangenuchten = soil_pars(2,soil_type) 2881 2880 ENDIF 2882 2881 2883 2882 IF ( hydraulic_conductivity == 9999999.9_wp ) THEN 2884 hydraulic_conductivity = soil_pars(3,soil_type) 2883 hydraulic_conductivity = soil_pars(3,soil_type) 2885 2884 ENDIF 2886 2885 2887 2886 IF ( saturation_moisture == 9999999.9_wp ) THEN 2888 saturation_moisture = soil_pars(4,soil_type) 2887 saturation_moisture = soil_pars(4,soil_type) 2889 2888 ENDIF 2890 2889 2891 2890 IF ( field_capacity == 9999999.9_wp ) THEN 2892 field_capacity = soil_pars(5,soil_type) 2891 field_capacity = soil_pars(5,soil_type) 2893 2892 ENDIF 2894 2893 2895 2894 IF ( wilting_point == 9999999.9_wp ) THEN 2896 wilting_point = soil_pars(6,soil_type) 2895 wilting_point = soil_pars(6,soil_type) 2897 2896 ENDIF 2898 2897 2899 2898 IF ( residual_moisture == 9999999.9_wp ) THEN 2900 residual_moisture = soil_pars(7,soil_type) 2899 residual_moisture = soil_pars(7,soil_type) 2901 2900 ENDIF 2902 2901 … … 2907 2906 surf_lsm_h%alpha_vg = alpha_vangenuchten 2908 2907 surf_lsm_h%l_vg = l_vangenuchten 2909 surf_lsm_h%n_vg = n_vangenuchten 2908 surf_lsm_h%n_vg = n_vangenuchten 2910 2909 surf_lsm_h%gamma_w_sat = hydraulic_conductivity 2911 2910 surf_lsm_h%m_sat = saturation_moisture … … 2919 2918 surf_lsm_v(l)%alpha_vg = alpha_vangenuchten 2920 2919 surf_lsm_v(l)%l_vg = l_vangenuchten 2921 surf_lsm_v(l)%n_vg = n_vangenuchten 2920 surf_lsm_v(l)%n_vg = n_vangenuchten 2922 2921 surf_lsm_v(l)%gamma_w_sat = hydraulic_conductivity 2923 2922 surf_lsm_v(l)%m_sat = saturation_moisture … … 2929 2928 ! 2930 2929 !-- Level 2, initialization of soil parameters via soil_type read from file. 2931 !-- Soil parameters are initialized for each (y,x)-grid point 2930 !-- Soil parameters are initialized for each (y,x)-grid point 2932 2931 !-- individually using default paramter settings according to the given 2933 2932 !-- soil type. 2934 2933 IF ( soil_type_f%from_file ) THEN 2935 2934 ! 2936 !-- Level of detail = 1, i.e. a homogeneous soil distribution along the 2935 !-- Level of detail = 1, i.e. a homogeneous soil distribution along the 2937 2936 !-- vertical dimension is assumed. 2938 2937 IF ( soil_type_f%lod == 1 ) THEN … … 2942 2941 i = surf_lsm_h%i(m) 2943 2942 j = surf_lsm_h%j(m) 2944 2943 2945 2944 st = soil_type_f%var_2d(j,i) 2946 2945 IF ( st /= soil_type_f%fill ) THEN … … 2956 2955 ENDDO 2957 2956 ! 2958 !-- Vertical surfaces ( assumes the soil type given at respective (x,y) 2957 !-- Vertical surfaces ( assumes the soil type given at respective (x,y) 2959 2958 DO l = 0, 3 2960 2959 DO m = 1, surf_lsm_v(l)%ns 2961 2960 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 2962 surf_lsm_v(l)%building_covered(m) ) 2961 surf_lsm_v(l)%building_covered(m) ) 2963 2962 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 2964 surf_lsm_v(l)%building_covered(m) ) 2963 surf_lsm_v(l)%building_covered(m) ) 2965 2964 2966 2965 st = soil_type_f%var_2d(j,i) … … 2979 2978 ! 2980 2979 !-- Level of detail = 2, i.e. soil type and thus the soil parameters 2981 !-- can be heterogeneous along the vertical dimension. 2980 !-- can be heterogeneous along the vertical dimension. 2982 2981 ELSE 2983 2982 ! … … 2986 2985 i = surf_lsm_h%i(m) 2987 2986 j = surf_lsm_h%j(m) 2988 2987 2989 2988 DO k = nzb_soil, nzt_soil 2990 2989 st = soil_type_f%var_3d(k,j,i) … … 3002 3001 ENDDO 3003 3002 ! 3004 !-- Vertical surfaces ( assumes the soil type given at respective (x,y) 3003 !-- Vertical surfaces ( assumes the soil type given at respective (x,y) 3005 3004 DO l = 0, 3 3006 3005 DO m = 1, surf_lsm_v(l)%ns 3007 3006 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 3008 surf_lsm_v(l)%building_covered(m) ) 3007 surf_lsm_v(l)%building_covered(m) ) 3009 3008 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 3010 surf_lsm_v(l)%building_covered(m) ) 3009 surf_lsm_v(l)%building_covered(m) ) 3011 3010 3012 3011 DO k = nzb_soil, nzt_soil … … 3028 3027 ENDIF 3029 3028 ! 3030 !-- Level 3, initialization of single soil parameters at single z,x,y 3029 !-- Level 3, initialization of single soil parameters at single z,x,y 3031 3030 !-- position via soil_pars read from file. 3032 3031 IF ( soil_pars_f%from_file ) THEN 3033 3032 ! 3034 !-- Level of detail = 1, i.e. a homogeneous vertical distribution of soil 3033 !-- Level of detail = 1, i.e. a homogeneous vertical distribution of soil 3035 3034 !-- parameters is assumed. 3036 3035 !-- Horizontal surfaces 3037 3036 IF ( soil_pars_f%lod == 1 ) THEN 3038 3037 ! 3039 !-- Horizontal surfaces 3038 !-- Horizontal surfaces 3040 3039 DO m = 1, surf_lsm_h%ns 3041 3040 i = surf_lsm_h%i(m) … … 3061 3060 ENDDO 3062 3061 ! 3063 !-- Vertical surfaces 3062 !-- Vertical surfaces 3064 3063 DO l = 0, 3 3065 3064 DO m = 1, surf_lsm_v(l)%ns 3066 3065 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 3067 surf_lsm_v(l)%building_covered(m) ) 3066 surf_lsm_v(l)%building_covered(m) ) 3068 3067 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 3069 surf_lsm_v(l)%building_covered(m) ) 3068 surf_lsm_v(l)%building_covered(m) ) 3070 3069 3071 3070 IF ( soil_pars_f%pars_xy(0,j,i) /= soil_pars_f%fill ) & … … 3089 3088 ENDDO 3090 3089 ! 3091 !-- Level of detail = 2, i.e. soil parameters can be set at each soil 3092 !-- layer individually. 3090 !-- Level of detail = 2, i.e. soil parameters can be set at each soil 3091 !-- layer individually. 3093 3092 ELSE 3094 3093 ! … … 3119 3118 ENDDO 3120 3119 ! 3121 !-- Vertical surfaces 3120 !-- Vertical surfaces 3122 3121 DO l = 0, 3 3123 3122 DO m = 1, surf_lsm_v(l)%ns 3124 3123 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 3125 surf_lsm_v(l)%building_covered(m) ) 3124 surf_lsm_v(l)%building_covered(m) ) 3126 3125 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 3127 surf_lsm_v(l)%building_covered(m) ) 3126 surf_lsm_v(l)%building_covered(m) ) 3128 3127 3129 3128 DO k = nzb_soil, nzt_soil … … 3153 3152 3154 3153 ! 3155 !-- Level 1, initialization of vegetation parameters. A horizontally 3156 !-- homogeneous distribution is assumed here. 3154 !-- Level 1, initialization of vegetation parameters. A horizontally 3155 !-- homogeneous distribution is assumed here. 3157 3156 IF ( vegetation_type /= 0 ) THEN 3158 3157 … … 3162 3161 3163 3162 IF ( leaf_area_index == 9999999.9_wp ) THEN 3164 leaf_area_index = vegetation_pars(ind_v_rc_lai,vegetation_type) 3163 leaf_area_index = vegetation_pars(ind_v_rc_lai,vegetation_type) 3165 3164 ENDIF 3166 3165 3167 3166 IF ( vegetation_coverage == 9999999.9_wp ) THEN 3168 vegetation_coverage = vegetation_pars(ind_v_c_veg,vegetation_type) 3167 vegetation_coverage = vegetation_pars(ind_v_c_veg,vegetation_type) 3169 3168 ENDIF 3170 3169 3171 3170 IF ( canopy_resistance_coefficient == 9999999.9_wp ) THEN 3172 canopy_resistance_coefficient= vegetation_pars(ind_v_gd,vegetation_type) 3171 canopy_resistance_coefficient= vegetation_pars(ind_v_gd,vegetation_type) 3173 3172 ENDIF 3174 3173 3175 3174 IF ( z0_vegetation == 9999999.9_wp ) THEN 3176 z0_vegetation = vegetation_pars(ind_v_z0,vegetation_type) 3175 z0_vegetation = vegetation_pars(ind_v_z0,vegetation_type) 3177 3176 ENDIF 3178 3177 3179 3178 IF ( z0h_vegetation == 9999999.9_wp ) THEN 3180 3179 z0h_vegetation = vegetation_pars(ind_v_z0qh,vegetation_type) 3181 ENDIF 3182 3180 ENDIF 3181 3183 3182 IF ( z0q_vegetation == 9999999.9_wp ) THEN 3184 3183 z0q_vegetation = vegetation_pars(ind_v_z0qh,vegetation_type) 3185 3184 ENDIF 3186 3185 3187 3186 IF ( lambda_surface_stable == 9999999.9_wp ) THEN 3188 lambda_surface_stable = vegetation_pars(ind_v_lambda_s,vegetation_type) 3187 lambda_surface_stable = vegetation_pars(ind_v_lambda_s,vegetation_type) 3189 3188 ENDIF 3190 3189 3191 3190 IF ( lambda_surface_unstable == 9999999.9_wp ) THEN 3192 lambda_surface_unstable = vegetation_pars(ind_v_lambda_u,vegetation_type) 3191 lambda_surface_unstable = vegetation_pars(ind_v_lambda_u,vegetation_type) 3193 3192 ENDIF 3194 3193 3195 3194 IF ( f_shortwave_incoming == 9999999.9_wp ) THEN 3196 f_shortwave_incoming = vegetation_pars(ind_v_f_sw_in,vegetation_type) 3195 f_shortwave_incoming = vegetation_pars(ind_v_f_sw_in,vegetation_type) 3197 3196 ENDIF 3198 3197 3199 3198 IF ( c_surface == 9999999.9_wp ) THEN 3200 c_surface = vegetation_pars(ind_v_c_surf,vegetation_type) 3199 c_surface = vegetation_pars(ind_v_c_surf,vegetation_type) 3201 3200 ENDIF 3202 3201 3203 3202 IF ( albedo_type == 9999999 .AND. albedo == 9999999.9_wp ) THEN 3204 albedo_type = INT(vegetation_pars(ind_v_at,vegetation_type)) 3205 ENDIF 3206 3203 albedo_type = INT(vegetation_pars(ind_v_at,vegetation_type)) 3204 ENDIF 3205 3207 3206 IF ( emissivity == 9999999.9_wp ) THEN 3208 emissivity = vegetation_pars(ind_v_emis,vegetation_type) 3207 emissivity = vegetation_pars(ind_v_emis,vegetation_type) 3209 3208 ENDIF 3210 3209 … … 3227 3226 surf_lsm_h%albedo_type(m,ind_veg_wall) = albedo_type 3228 3227 surf_lsm_h%emissivity(m,ind_veg_wall) = emissivity 3229 3228 3230 3229 surf_lsm_h%vegetation_type(m) = vegetation_type 3231 3230 surf_lsm_h%vegetation_type_name(m) = vegetation_type_name(vegetation_type) … … 3235 3234 surf_lsm_h%g_d(m) = 0.0_wp 3236 3235 ENDIF 3237 3236 3238 3237 ENDDO 3239 3238 ! … … 3256 3255 surf_lsm_v(l)%albedo_type(m,ind_veg_wall) = albedo_type 3257 3256 surf_lsm_v(l)%emissivity(m,ind_veg_wall) = emissivity 3258 3257 3259 3258 surf_lsm_v(l)%vegetation_type(m) = vegetation_type 3260 3259 surf_lsm_v(l)%vegetation_type_name(m) = vegetation_type_name(vegetation_type) … … 3269 3268 ! 3270 3269 !-- Level 2, initialization of vegation parameters via vegetation_type read 3271 !-- from file. Vegetation parameters are initialized for each (y,x)-grid point 3270 !-- from file. Vegetation parameters are initialized for each (y,x)-grid point 3272 3271 !-- individually using default paramter settings according to the given 3273 3272 !-- vegetation type. … … 3278 3277 i = surf_lsm_h%i(m) 3279 3278 j = surf_lsm_h%j(m) 3280 3279 3281 3280 st = vegetation_type_f%var(j,i) 3282 3281 IF ( st /= vegetation_type_f%fill .AND. st /= 0 ) THEN … … 3294 3293 surf_lsm_h%albedo_type(m,ind_veg_wall) = INT( vegetation_pars(ind_v_at,st) ) 3295 3294 surf_lsm_h%emissivity(m,ind_veg_wall) = vegetation_pars(ind_v_emis,st) 3296 3295 3297 3296 surf_lsm_h%vegetation_type(m) = st 3298 3297 surf_lsm_h%vegetation_type_name(m) = vegetation_type_name(st) … … 3304 3303 DO m = 1, surf_lsm_v(l)%ns 3305 3304 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 3306 surf_lsm_v(l)%building_covered(m) ) 3305 surf_lsm_v(l)%building_covered(m) ) 3307 3306 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 3308 surf_lsm_v(l)%building_covered(m) ) 3309 3307 surf_lsm_v(l)%building_covered(m) ) 3308 3310 3309 st = vegetation_type_f%var(j,i) 3311 3310 IF ( st /= vegetation_type_f%fill .AND. st /= 0 ) THEN … … 3323 3322 surf_lsm_v(l)%albedo_type(m,ind_veg_wall) = INT( vegetation_pars(ind_v_at,st) ) 3324 3323 surf_lsm_v(l)%emissivity(m,ind_veg_wall) = vegetation_pars(ind_v_emis,st) 3325 3324 3326 3325 surf_lsm_v(l)%vegetation_type(m) = st 3327 3326 surf_lsm_v(l)%vegetation_type_name(m) = vegetation_type_name(st) … … 3331 3330 ENDIF 3332 3331 ! 3333 !-- Level 3, initialization of vegation parameters at single (x,y) 3332 !-- Level 3, initialization of vegation parameters at single (x,y) 3334 3333 !-- position via vegetation_pars read from file. 3335 3334 IF ( vegetation_pars_f%from_file ) THEN 3336 3335 ! 3337 !-- Horizontal surfaces 3336 !-- Horizontal surfaces 3338 3337 DO m = 1, surf_lsm_h%ns 3339 3338 … … 3341 3340 j = surf_lsm_h%j(m) 3342 3341 ! 3343 !-- If surface element is not a vegetation surface and any value in 3342 !-- If surface element is not a vegetation surface and any value in 3344 3343 !-- vegetation_pars is given, neglect this information and give an 3345 !-- informative message that this value will not be used. 3344 !-- informative message that this value will not be used. 3346 3345 IF ( .NOT. surf_lsm_h%vegetation_surface(m) .AND. & 3347 3346 ANY( vegetation_pars_f%pars_xy(:,j,i) /= & … … 3351 3350 j, i, ') is not a vegetation surface, ', & 3352 3351 'so that information given in ', & 3353 'vegetation_pars at this point is neglected.' 3352 'vegetation_pars at this point is neglected.' 3354 3353 CALL message( 'land_surface_model_mod', 'PA0436', 0, 0, myid, 6, 0 ) 3355 3354 ELSE … … 3409 3408 ENDDO 3410 3409 ! 3411 !-- Vertical surfaces 3410 !-- Vertical surfaces 3412 3411 DO l = 0, 3 3413 3412 DO m = 1, surf_lsm_v(l)%ns 3414 3413 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 3415 surf_lsm_v(l)%building_covered(m) ) 3414 surf_lsm_v(l)%building_covered(m) ) 3416 3415 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 3417 surf_lsm_v(l)%building_covered(m) ) 3418 ! 3419 !-- If surface element is not a vegetation surface and any value in 3416 surf_lsm_v(l)%building_covered(m) ) 3417 ! 3418 !-- If surface element is not a vegetation surface and any value in 3420 3419 !-- vegetation_pars is given, neglect this information and give an 3421 !-- informative message that this value will not be used. 3420 !-- informative message that this value will not be used. 3422 3421 IF ( .NOT. surf_lsm_v(l)%vegetation_surface(m) .AND. & 3423 3422 ANY( vegetation_pars_f%pars_xy(:,j,i) /= & … … 3427 3426 j, i, ') is not a vegetation surface, ', & 3428 3427 'so that information given in ', & 3429 'vegetation_pars at this point is neglected.' 3428 'vegetation_pars at this point is neglected.' 3430 3429 CALL message( 'land_surface_model_mod', 'PA0436', 0, 0, myid, 6, 0 ) 3431 3430 ELSE … … 3486 3485 ENDDO 3487 3486 ENDDO 3488 ENDIF 3489 3490 ! 3491 !-- Level 1, initialization of water parameters. A horizontally 3492 !-- homogeneous distribution is assumed here. 3487 ENDIF 3488 3489 ! 3490 !-- Level 1, initialization of water parameters. A horizontally 3491 !-- homogeneous distribution is assumed here. 3493 3492 IF ( water_type /= 0 ) THEN 3494 3493 3495 3494 IF ( water_temperature == 9999999.9_wp ) THEN 3496 water_temperature = water_pars(ind_w_temp,water_type) 3495 water_temperature = water_pars(ind_w_temp,water_type) 3497 3496 ENDIF 3498 3497 3499 3498 IF ( z0_water == 9999999.9_wp ) THEN 3500 z0_water = water_pars(ind_w_z0,water_type) 3501 ENDIF 3499 z0_water = water_pars(ind_w_z0,water_type) 3500 ENDIF 3502 3501 3503 3502 IF ( z0h_water == 9999999.9_wp ) THEN 3504 z0h_water = water_pars(ind_w_z0h,water_type) 3505 ENDIF 3506 3503 z0h_water = water_pars(ind_w_z0h,water_type) 3504 ENDIF 3505 3507 3506 IF ( z0q_water == 9999999.9_wp ) THEN 3508 z0q_water = water_pars(ind_w_z0h,water_type) 3509 ENDIF 3507 z0q_water = water_pars(ind_w_z0h,water_type) 3508 ENDIF 3510 3509 3511 3510 IF ( albedo_type == 9999999 .AND. albedo == 9999999.9_wp ) THEN 3512 albedo_type = INT(water_pars(ind_w_at,water_type)) 3513 ENDIF 3514 3511 albedo_type = INT(water_pars(ind_w_at,water_type)) 3512 ENDIF 3513 3515 3514 IF ( emissivity == 9999999.9_wp ) THEN 3516 emissivity = water_pars(ind_w_emis,water_type) 3517 ENDIF 3518 3519 ENDIF 3515 emissivity = water_pars(ind_w_emis,water_type) 3516 ENDIF 3517 3518 ENDIF 3520 3519 ! 3521 3520 !-- Map values onto horizontal elemements … … 3528 3527 surf_lsm_h%z0q(m) = z0q_water 3529 3528 surf_lsm_h%lambda_surface_s(m) = 1.0E10_wp 3530 surf_lsm_h%lambda_surface_u(m) = 1.0E10_wp 3529 surf_lsm_h%lambda_surface_u(m) = 1.0E10_wp 3531 3530 surf_lsm_h%c_surface(m) = 0.0_wp 3532 3531 surf_lsm_h%albedo_type(m,ind_wat_win) = albedo_type 3533 3532 surf_lsm_h%emissivity(m,ind_wat_win) = emissivity 3534 3533 3535 3534 surf_lsm_h%water_type(m) = water_type 3536 3535 surf_lsm_h%water_type_name(m) = water_type_name(water_type) … … 3549 3548 surf_lsm_v(l)%z0q(m) = z0q_water 3550 3549 surf_lsm_v(l)%lambda_surface_s(m) = 1.0E10_wp 3551 surf_lsm_v(l)%lambda_surface_u(m) = 1.0E10_wp 3550 surf_lsm_v(l)%lambda_surface_u(m) = 1.0E10_wp 3552 3551 surf_lsm_v(l)%c_surface(m) = 0.0_wp 3553 3552 surf_lsm_v(l)%albedo_type(m,ind_wat_win) = albedo_type 3554 3553 surf_lsm_v(l)%emissivity(m,ind_wat_win) = emissivity 3555 3554 3556 3555 surf_lsm_v(l)%water_type(m) = water_type 3557 3556 surf_lsm_v(l)%water_type_name(m) = water_type_name(water_type) 3558 ENDIF 3557 ENDIF 3559 3558 ENDDO 3560 3559 ENDDO … … 3562 3561 ! 3563 3562 !-- Level 2, initialization of water parameters via water_type read 3564 !-- from file. Water surfaces are initialized for each (y,x)-grid point 3563 !-- from file. Water surfaces are initialized for each (y,x)-grid point 3565 3564 !-- individually using default paramter settings according to the given 3566 3565 !-- water type. … … 3573 3572 i = surf_lsm_h%i(m) 3574 3573 j = surf_lsm_h%j(m) 3575 3574 3576 3575 st = water_type_f%var(j,i) 3577 3576 IF ( st /= water_type_f%fill .AND. st /= 0 ) THEN … … 3582 3581 surf_lsm_h%z0q(m) = water_pars(ind_w_z0h,st) 3583 3582 surf_lsm_h%lambda_surface_s(m) = water_pars(ind_w_lambda_s,st) 3584 surf_lsm_h%lambda_surface_u(m) = water_pars(ind_w_lambda_u,st) 3583 surf_lsm_h%lambda_surface_u(m) = water_pars(ind_w_lambda_u,st) 3585 3584 surf_lsm_h%c_surface(m) = 0.0_wp 3586 3585 surf_lsm_h%albedo_type(m,ind_wat_win) = INT( water_pars(ind_w_at,st) ) 3587 3586 surf_lsm_h%emissivity(m,ind_wat_win) = water_pars(ind_w_emis,st) 3588 3587 3589 3588 surf_lsm_h%water_type(m) = st 3590 3589 surf_lsm_h%water_type_name(m) = water_type_name(st) … … 3596 3595 DO m = 1, surf_lsm_v(l)%ns 3597 3596 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 3598 surf_lsm_v(l)%building_covered(m) ) 3597 surf_lsm_v(l)%building_covered(m) ) 3599 3598 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 3600 surf_lsm_v(l)%building_covered(m) ) 3601 3599 surf_lsm_v(l)%building_covered(m) ) 3600 3602 3601 st = water_type_f%var(j,i) 3603 3602 IF ( st /= water_type_f%fill .AND. st /= 0 ) THEN … … 3610 3609 water_pars(ind_w_lambda_s,st) 3611 3610 surf_lsm_v(l)%lambda_surface_u(m) = & 3612 water_pars(ind_w_lambda_u,st) 3611 water_pars(ind_w_lambda_u,st) 3613 3612 surf_lsm_v(l)%c_surface(m) = 0.0_wp 3614 3613 surf_lsm_v(l)%albedo_type(m,ind_wat_win) = & … … 3616 3615 surf_lsm_v(l)%emissivity(m,ind_wat_win) = & 3617 3616 water_pars(ind_w_emis,st) 3618 3617 3619 3618 surf_lsm_v(l)%water_type(m) = st 3620 3619 surf_lsm_v(l)%water_type_name(m) = water_type_name(st) … … 3622 3621 ENDDO 3623 3622 ENDDO 3624 ENDIF 3625 3626 ! 3627 !-- Level 3, initialization of water parameters at single (x,y) 3623 ENDIF 3624 3625 ! 3626 !-- Level 3, initialization of water parameters at single (x,y) 3628 3627 !-- position via water_pars read from file. 3629 3628 IF ( water_pars_f%from_file ) THEN 3630 3629 ! 3631 !-- Horizontal surfaces 3630 !-- Horizontal surfaces 3632 3631 DO m = 1, surf_lsm_h%ns 3633 3632 i = surf_lsm_h%i(m) 3634 3633 j = surf_lsm_h%j(m) 3635 3634 ! 3636 !-- If surface element is not a water surface and any value in 3635 !-- If surface element is not a water surface and any value in 3637 3636 !-- water_pars is given, neglect this information and give an 3638 !-- informative message that this value will not be used. 3637 !-- informative message that this value will not be used. 3639 3638 IF ( .NOT. surf_lsm_h%water_surface(m) .AND. & 3640 3639 ANY( water_pars_f%pars_xy(:,j,i) /= water_pars_f%fill ) ) THEN … … 3643 3642 j, i, ') is not a water surface, ', & 3644 3643 'so that information given in ', & 3645 'water_pars at this point is neglected.' 3644 'water_pars at this point is neglected.' 3646 3645 CALL message( 'land_surface_model_mod', 'PA0645', 0, 0, myid, 6, 0 ) 3647 3646 ELSE … … 3667 3666 water_pars_f%fill ) & 3668 3667 surf_lsm_h%lambda_surface_u(m) = & 3669 water_pars_f%pars_xy(ind_w_lambda_u,j,i) 3670 3668 water_pars_f%pars_xy(ind_w_lambda_u,j,i) 3669 3671 3670 IF ( water_pars_f%pars_xy(ind_w_at,j,i) /= & 3672 3671 water_pars_f%fill ) & … … 3677 3676 water_pars_f%fill ) & 3678 3677 surf_lsm_h%emissivity(m,ind_wat_win) = & 3679 water_pars_f%pars_xy(ind_w_emis,j,i) 3678 water_pars_f%pars_xy(ind_w_emis,j,i) 3680 3679 ENDIF 3681 3680 ENDDO 3682 3681 ! 3683 !-- Vertical surfaces 3682 !-- Vertical surfaces 3684 3683 DO l = 0, 3 3685 3684 DO m = 1, surf_lsm_v(l)%ns 3686 3685 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 3687 surf_lsm_v(l)%building_covered(m) ) 3686 surf_lsm_v(l)%building_covered(m) ) 3688 3687 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 3689 surf_lsm_v(l)%building_covered(m) ) 3690 ! 3691 !-- If surface element is not a water surface and any value in 3688 surf_lsm_v(l)%building_covered(m) ) 3689 ! 3690 !-- If surface element is not a water surface and any value in 3692 3691 !-- water_pars is given, neglect this information and give an 3693 !-- informative message that this value will not be used. 3692 !-- informative message that this value will not be used. 3694 3693 IF ( .NOT. surf_lsm_v(l)%water_surface(m) .AND. & 3695 3694 ANY( water_pars_f%pars_xy(:,j,i) /= & … … 3699 3698 j, i, ') is not a water surface, ', & 3700 3699 'so that information given in ', & 3701 'water_pars at this point is neglected.' 3700 'water_pars at this point is neglected.' 3702 3701 CALL message( 'land_surface_model_mod', 'PA0645', & 3703 3702 0, 0, myid, 6, 0 ) … … 3727 3726 water_pars_f%fill ) & 3728 3727 surf_lsm_v(l)%lambda_surface_u(m) = & 3729 water_pars_f%pars_xy(ind_w_lambda_u,j,i) 3730 3728 water_pars_f%pars_xy(ind_w_lambda_u,j,i) 3729 3731 3730 IF ( water_pars_f%pars_xy(ind_w_at,j,i) /= & 3732 3731 water_pars_f%fill ) & … … 3737 3736 water_pars_f%fill ) & 3738 3737 surf_lsm_v(l)%emissivity(m,ind_wat_win) = & 3739 water_pars_f%pars_xy(ind_w_emis,j,i) 3738 water_pars_f%pars_xy(ind_w_emis,j,i) 3740 3739 ENDIF 3741 3740 ENDDO … … 3745 3744 ! 3746 3745 !-- Initialize pavement-type surfaces, level 1 3747 IF ( pavement_type /= 0 ) THEN 3748 3749 ! 3750 !-- When a pavement_type is used, overwrite a possible setting of 3746 IF ( pavement_type /= 0 ) THEN 3747 3748 ! 3749 !-- When a pavement_type is used, overwrite a possible setting of 3751 3750 !-- the pavement depth as it is already defined by the pavement type 3752 3751 pavement_depth_level = 0 3753 3752 3754 3753 IF ( z0_pavement == 9999999.9_wp ) THEN 3755 z0_pavement = pavement_pars(ind_p_z0,pavement_type) 3754 z0_pavement = pavement_pars(ind_p_z0,pavement_type) 3756 3755 ENDIF 3757 3756 … … 3759 3758 z0h_pavement = pavement_pars(ind_p_z0h,pavement_type) 3760 3759 ENDIF 3761 3760 3762 3761 IF ( z0q_pavement == 9999999.9_wp ) THEN 3763 3762 z0q_pavement = pavement_pars(ind_p_z0h,pavement_type) … … 3770 3769 IF ( pavement_heat_capacity == 9999999.9_wp ) THEN 3771 3770 pavement_heat_capacity = pavement_subsurface_pars_2(0,pavement_type) 3772 ENDIF 3773 3771 ENDIF 3772 3774 3773 IF ( albedo_type == 9999999 .AND. albedo == 9999999.9_wp ) THEN 3775 albedo_type = INT(pavement_pars(ind_p_at,pavement_type)) 3776 ENDIF 3777 3774 albedo_type = INT(pavement_pars(ind_p_at,pavement_type)) 3775 ENDIF 3776 3778 3777 IF ( emissivity == 9999999.9_wp ) THEN 3779 emissivity = pavement_pars(ind_p_emis,pavement_type) 3778 emissivity = pavement_pars(ind_p_emis,pavement_type) 3780 3779 ENDIF 3781 3780 … … 3784 3783 !-- lookup table. 3785 3784 IF ( pavement_depth_level == 0 ) THEN 3786 DO k = nzb_soil, nzt_soil 3785 DO k = nzb_soil, nzt_soil 3787 3786 IF ( pavement_subsurface_pars_1(k,pavement_type) == 9999999.9_wp & 3788 3787 .OR. pavement_subsurface_pars_2(k,pavement_type) == 9999999.9_wp)& … … 3798 3797 ENDIF 3799 3798 ! 3800 !-- Level 1 initialization of pavement type surfaces. Horizontally 3799 !-- Level 1 initialization of pavement type surfaces. Horizontally 3801 3800 !-- homogeneous characteristics are assumed 3802 3801 surf_lsm_h%nzt_pavement = pavement_depth_level … … 3809 3808 surf_lsm_h%lambda_surface_s(m) = pavement_heat_conduct & 3810 3809 * ddz_soil(nzb_soil) & 3811 * 2.0_wp 3810 * 2.0_wp 3812 3811 surf_lsm_h%lambda_surface_u(m) = pavement_heat_conduct & 3813 3812 * ddz_soil(nzb_soil) & 3814 * 2.0_wp 3813 * 2.0_wp 3815 3814 surf_lsm_h%c_surface(m) = pavement_heat_capacity & 3816 3815 * dz_soil(nzb_soil) & 3817 * 0.25_wp 3816 * 0.25_wp 3818 3817 3819 3818 surf_lsm_h%albedo_type(m,ind_pav_green) = albedo_type 3820 surf_lsm_h%emissivity(m,ind_pav_green) = emissivity 3821 3819 surf_lsm_h%emissivity(m,ind_pav_green) = emissivity 3820 3822 3821 surf_lsm_h%pavement_type(m) = pavement_type 3823 3822 surf_lsm_h%pavement_type_name(m) = pavement_type_name(pavement_type) 3824 3823 3825 3824 IF ( pavement_type /= 0 ) THEN 3826 3825 DO k = nzb_soil, surf_lsm_h%nzt_pavement(m) 3827 3826 surf_lsm_h%lambda_h_def(k,m) = & 3828 pavement_subsurface_pars_1(k,pavement_type) 3827 pavement_subsurface_pars_1(k,pavement_type) 3829 3828 surf_lsm_h%rho_c_total_def(k,m) = & 3830 pavement_subsurface_pars_2(k,pavement_type) 3829 pavement_subsurface_pars_2(k,pavement_type) 3831 3830 ENDDO 3832 3831 ELSE 3833 3832 surf_lsm_h%lambda_h_def(:,m) = pavement_heat_conduct 3834 3833 surf_lsm_h%rho_c_total_def(:,m) = pavement_heat_capacity 3835 ENDIF 3836 ENDIF 3837 ENDDO 3834 ENDIF 3835 ENDIF 3836 ENDDO 3838 3837 3839 3838 DO l = 0, 3 … … 3847 3846 surf_lsm_v(l)%lambda_surface_s(m) = pavement_heat_conduct & 3848 3847 * ddz_soil(nzb_soil) & 3849 * 2.0_wp 3848 * 2.0_wp 3850 3849 surf_lsm_v(l)%lambda_surface_u(m) = pavement_heat_conduct & 3851 3850 * ddz_soil(nzb_soil) & 3852 * 2.0_wp 3851 * 2.0_wp 3853 3852 surf_lsm_v(l)%c_surface(m) = pavement_heat_capacity & 3854 3853 * dz_soil(nzb_soil) & 3855 * 0.25_wp 3854 * 0.25_wp 3856 3855 3857 3856 surf_lsm_v(l)%albedo_type(m,ind_pav_green) = albedo_type 3858 3857 surf_lsm_v(l)%emissivity(m,ind_pav_green) = emissivity 3859 3858 3860 3859 surf_lsm_v(l)%pavement_type(m) = pavement_type 3861 3860 surf_lsm_v(l)%pavement_type_name(m) = pavement_type_name(pavement_type) … … 3864 3863 DO k = nzb_soil, surf_lsm_v(l)%nzt_pavement(m) 3865 3864 surf_lsm_v(l)%lambda_h_def(k,m) = & 3866 pavement_subsurface_pars_1(k,pavement_type) 3865 pavement_subsurface_pars_1(k,pavement_type) 3867 3866 surf_lsm_v(l)%rho_c_total_def(k,m) = & 3868 pavement_subsurface_pars_2(k,pavement_type) 3867 pavement_subsurface_pars_2(k,pavement_type) 3869 3868 ENDDO 3870 3869 ELSE 3871 3870 surf_lsm_v(l)%lambda_h_def(:,m) = pavement_heat_conduct 3872 3871 surf_lsm_v(l)%rho_c_total_def(:,m) = pavement_heat_capacity 3873 ENDIF 3872 ENDIF 3874 3873 ENDIF 3875 3874 ENDDO … … 3877 3876 ! 3878 3877 !-- Level 2 initialization of pavement type surfaces via pavement_type read 3879 !-- from file. Pavement surfaces are initialized for each (y,x)-grid point 3878 !-- from file. Pavement surfaces are initialized for each (y,x)-grid point 3880 3879 !-- individually. 3881 3880 IF ( pavement_type_f%from_file ) THEN … … 3885 3884 i = surf_lsm_h%i(m) 3886 3885 j = surf_lsm_h%j(m) 3887 3886 3888 3887 st = pavement_type_f%var(j,i) 3889 3888 IF ( st /= pavement_type_f%fill .AND. st /= 0 ) THEN 3890 3889 ! 3891 3890 !-- Determine deepmost index of pavement layer 3892 DO k = nzb_soil, nzt_soil 3891 DO k = nzb_soil, nzt_soil 3893 3892 IF ( pavement_subsurface_pars_1(k,st) == 9999999.9_wp & 3894 3893 .OR. pavement_subsurface_pars_2(k,st) == 9999999.9_wp) & … … 3906 3905 pavement_subsurface_pars_1(0,st) & 3907 3906 * ddz_soil(nzb_soil) & 3908 * 2.0_wp 3907 * 2.0_wp 3909 3908 surf_lsm_h%lambda_surface_u(m) = & 3910 3909 pavement_subsurface_pars_1(0,st) & 3911 3910 * ddz_soil(nzb_soil) & 3912 * 2.0_wp 3911 * 2.0_wp 3913 3912 surf_lsm_h%c_surface(m) = & 3914 3913 pavement_subsurface_pars_2(0,st)& 3915 3914 * dz_soil(nzb_soil) & 3916 * 0.25_wp 3915 * 0.25_wp 3917 3916 surf_lsm_h%albedo_type(m,ind_pav_green) = INT( pavement_pars(ind_p_at,st) ) 3918 surf_lsm_h%emissivity(m,ind_pav_green) = pavement_pars(ind_p_emis,st) 3919 3917 surf_lsm_h%emissivity(m,ind_pav_green) = pavement_pars(ind_p_emis,st) 3918 3920 3919 surf_lsm_h%pavement_type(m) = st 3921 3920 surf_lsm_h%pavement_type_name(m) = pavement_type_name(st) … … 3923 3922 DO k = nzb_soil, surf_lsm_h%nzt_pavement(m) 3924 3923 surf_lsm_h%lambda_h_def(k,m) = & 3925 pavement_subsurface_pars_1(k,pavement_type) 3924 pavement_subsurface_pars_1(k,pavement_type) 3926 3925 surf_lsm_h%rho_c_total_def(k,m) = & 3927 pavement_subsurface_pars_2(k,pavement_type) 3928 ENDDO 3926 pavement_subsurface_pars_2(k,pavement_type) 3927 ENDDO 3929 3928 ENDIF 3930 3929 ENDDO … … 3934 3933 DO m = 1, surf_lsm_v(l)%ns 3935 3934 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 3936 surf_lsm_v(l)%building_covered(m) ) 3935 surf_lsm_v(l)%building_covered(m) ) 3937 3936 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 3938 surf_lsm_v(l)%building_covered(m) ) 3939 3937 surf_lsm_v(l)%building_covered(m) ) 3938 3940 3939 st = pavement_type_f%var(j,i) 3941 3940 IF ( st /= pavement_type_f%fill .AND. st /= 0 ) THEN 3942 3941 ! 3943 3942 !-- Determine deepmost index of pavement layer 3944 DO k = nzb_soil, nzt_soil 3943 DO k = nzb_soil, nzt_soil 3945 3944 IF ( pavement_subsurface_pars_1(k,st) == 9999999.9_wp & 3946 3945 .OR. pavement_subsurface_pars_2(k,st) == 9999999.9_wp) & … … 3957 3956 surf_lsm_v(l)%lambda_surface_s(m) = & 3958 3957 pavement_subsurface_pars_1(0,st) & 3959 * ddz_soil(nzb_soil) & 3960 * 2.0_wp 3958 * ddz_soil(nzb_soil) & 3959 * 2.0_wp 3961 3960 surf_lsm_v(l)%lambda_surface_u(m) = & 3962 3961 pavement_subsurface_pars_1(0,st) & 3963 3962 * ddz_soil(nzb_soil) & 3964 * 2.0_wp 3963 * 2.0_wp 3965 3964 3966 3965 surf_lsm_v(l)%c_surface(m) = & 3967 3966 pavement_subsurface_pars_2(0,st) & 3968 3967 * dz_soil(nzb_soil) & 3969 * 0.25_wp 3968 * 0.25_wp 3970 3969 surf_lsm_v(l)%albedo_type(m,ind_pav_green) = & 3971 3970 INT( pavement_pars(ind_p_at,st) ) 3972 3971 surf_lsm_v(l)%emissivity(m,ind_pav_green) = & 3973 pavement_pars(ind_p_emis,st) 3974 3972 pavement_pars(ind_p_emis,st) 3973 3975 3974 surf_lsm_v(l)%pavement_type(m) = st 3976 3975 surf_lsm_v(l)%pavement_type_name(m) = pavement_type_name(st) 3977 3976 3978 3977 DO k = nzb_soil, surf_lsm_v(l)%nzt_pavement(m) 3979 3978 surf_lsm_v(l)%lambda_h_def(k,m) = & 3980 pavement_subsurface_pars_1(k,pavement_type) 3979 pavement_subsurface_pars_1(k,pavement_type) 3981 3980 surf_lsm_v(l)%rho_c_total_def(k,m) = & 3982 pavement_subsurface_pars_2(k,pavement_type) 3983 ENDDO 3981 pavement_subsurface_pars_2(k,pavement_type) 3982 ENDDO 3984 3983 ENDIF 3985 3984 ENDDO 3986 3985 ENDDO 3987 ENDIF 3988 ! 3989 !-- Level 3, initialization of pavement parameters at single (x,y) 3986 ENDIF 3987 ! 3988 !-- Level 3, initialization of pavement parameters at single (x,y) 3990 3989 !-- position via pavement_pars read from file. 3991 3990 IF ( pavement_pars_f%from_file ) THEN 3992 3991 ! 3993 !-- Horizontal surfaces 3992 !-- Horizontal surfaces 3994 3993 DO m = 1, surf_lsm_h%ns 3995 3994 i = surf_lsm_h%i(m) 3996 3995 j = surf_lsm_h%j(m) 3997 3996 ! 3998 !-- If surface element is not a pavement surface and any value in 3997 !-- If surface element is not a pavement surface and any value in 3999 3998 !-- pavement_pars is given, neglect this information and give an 4000 !-- informative message that this value will not be used. 3999 !-- informative message that this value will not be used. 4001 4000 IF ( .NOT. surf_lsm_h%pavement_surface(m) .AND. & 4002 4001 ANY( pavement_pars_f%pars_xy(:,j,i) /= & … … 4006 4005 j, i, ') is not a pavement surface, ', & 4007 4006 'so that information given in ', & 4008 'pavement_pars at this point is neglected.' 4007 'pavement_pars at this point is neglected.' 4009 4008 CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 ) 4010 4009 ELSE … … 4026 4025 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)& 4027 4026 * ddz_soil(nzb_soil) & 4028 * 2.0_wp 4027 * 2.0_wp 4029 4028 ENDIF 4030 4029 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) /= & … … 4033 4032 pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) & 4034 4033 * dz_soil(nzb_soil) & 4035 * 0.25_wp 4034 * 0.25_wp 4036 4035 ENDIF 4037 4036 IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= & … … 4043 4042 surf_lsm_h%emissivity(m,ind_pav_green) = & 4044 4043 pavement_pars_f%pars_xy(ind_p_emis,j,i) 4045 ENDIF 4044 ENDIF 4046 4045 4047 4046 ENDDO 4048 4047 ! 4049 !-- Vertical surfaces 4048 !-- Vertical surfaces 4050 4049 DO l = 0, 3 4051 4050 DO m = 1, surf_lsm_v(l)%ns 4052 4051 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 4053 surf_lsm_v(l)%building_covered(m) ) 4052 surf_lsm_v(l)%building_covered(m) ) 4054 4053 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 4055 surf_lsm_v(l)%building_covered(m) ) 4056 ! 4057 !-- If surface element is not a pavement surface and any value in 4054 surf_lsm_v(l)%building_covered(m) ) 4055 ! 4056 !-- If surface element is not a pavement surface and any value in 4058 4057 !-- pavement_pars is given, neglect this information and give an 4059 !-- informative message that this value will not be used. 4058 !-- informative message that this value will not be used. 4060 4059 IF ( .NOT. surf_lsm_v(l)%pavement_surface(m) .AND. & 4061 4060 ANY( pavement_pars_f%pars_xy(:,j,i) /= & … … 4065 4064 j, i, ') is not a pavement surface, ', & 4066 4065 'so that information given in ', & 4067 'pavement_pars at this point is neglected.' 4066 'pavement_pars at this point is neglected.' 4068 4067 CALL message( 'land_surface_model_mod', 'PA0647', 0, 0, myid, 6, 0 ) 4069 4068 ELSE … … 4086 4085 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i)& 4087 4086 * ddz_soil(nzb_soil) & 4088 * 2.0_wp 4087 * 2.0_wp 4089 4088 ENDIF 4090 4089 IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i) & … … 4093 4092 pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i)& 4094 4093 * dz_soil(nzb_soil) & 4095 * 0.25_wp 4094 * 0.25_wp 4096 4095 ENDIF 4097 4096 IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /= & … … 4103 4102 pavement_pars_f%fill ) & 4104 4103 surf_lsm_v(l)%emissivity(m,ind_pav_green) = & 4105 pavement_pars_f%pars_xy(ind_p_emis,j,i) 4106 ENDIF 4104 pavement_pars_f%pars_xy(ind_p_emis,j,i) 4105 ENDIF 4107 4106 ENDDO 4108 4107 ENDDO 4109 4108 ENDIF 4110 4109 ! 4111 !-- Moreover, for grid points which are flagged with pavement-type 0 or whre 4112 !-- pavement_subsurface_pars_f is provided, soil heat conductivity and 4113 !-- capacity are initialized with parameters given in 4114 !-- pavement_subsurface_pars read from file. 4110 !-- Moreover, for grid points which are flagged with pavement-type 0 or whre 4111 !-- pavement_subsurface_pars_f is provided, soil heat conductivity and 4112 !-- capacity are initialized with parameters given in 4113 !-- pavement_subsurface_pars read from file. 4115 4114 IF ( pavement_subsurface_pars_f%from_file ) THEN 4116 4115 ! 4117 !-- Set pavement depth to nzt_soil. Please note, this is just a 4118 !-- workaround at the moment. 4116 !-- Set pavement depth to nzt_soil. Please note, this is just a 4117 !-- workaround at the moment. 4119 4118 DO m = 1, surf_lsm_h%ns 4120 4119 IF ( surf_lsm_h%pavement_surface(m) ) THEN … … 4125 4124 surf_lsm_h%nzt_pavement(m) = nzt_soil 4126 4125 4127 DO k = nzb_soil, nzt_soil 4126 DO k = nzb_soil, nzt_soil 4128 4127 surf_lsm_h%lambda_h_def(k,m) = & 4129 4128 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i) … … 4139 4138 4140 4139 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 4141 surf_lsm_v(l)%building_covered(m) ) 4140 surf_lsm_v(l)%building_covered(m) ) 4142 4141 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 4143 surf_lsm_v(l)%building_covered(m) ) 4142 surf_lsm_v(l)%building_covered(m) ) 4144 4143 4145 4144 surf_lsm_v(l)%nzt_pavement(m) = nzt_soil 4146 4145 4147 DO k = nzb_soil, nzt_soil 4146 DO k = nzb_soil, nzt_soil 4148 4147 surf_lsm_v(l)%lambda_h_def(k,m) = & 4149 4148 pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i) … … 4161 4160 IF ( TRIM( initializing_actions ) /= 'read_restart_data' ) THEN 4162 4161 ! 4163 !-- First, initialize soil temperature and moisture. 4164 !-- According to the initialization for surface and soil parameters, 4165 !-- initialize soil moisture and temperature via a level approach. This 4166 !-- is to assure that all surface elements are initialized, even if 4162 !-- First, initialize soil temperature and moisture. 4163 !-- According to the initialization for surface and soil parameters, 4164 !-- initialize soil moisture and temperature via a level approach. This 4165 !-- is to assure that all surface elements are initialized, even if 4167 4166 !-- data provided from input file contains fill values at some locations. 4168 4167 !-- Level 1, initialization via profiles given in parameter file … … 4170 4169 IF ( surf_lsm_h%vegetation_surface(m) .OR. & 4171 4170 surf_lsm_h%pavement_surface(m) ) THEN 4172 DO k = nzb_soil, nzt_soil 4171 DO k = nzb_soil, nzt_soil 4173 4172 t_soil_h%var_2d(k,m) = soil_temperature(k) 4174 4173 m_soil_h%var_2d(k,m) = soil_moisture(k) … … 4181 4180 IF ( surf_lsm_v(l)%vegetation_surface(m) .OR. & 4182 4181 surf_lsm_v(l)%pavement_surface(m) ) THEN 4183 DO k = nzb_soil, nzt_soil 4182 DO k = nzb_soil, nzt_soil 4184 4183 t_soil_v(l)%var_2d(k,m) = soil_temperature(k) 4185 4184 m_soil_v(l)%var_2d(k,m) = soil_moisture(k) … … 4190 4189 ENDDO 4191 4190 ! 4192 !-- Level 2 initialization of the soil, read soil properties from 4193 !-- dynamic input file. 4191 !-- Level 2 initialization of the soil, read soil properties from 4192 !-- dynamic input file. 4194 4193 IF ( input_pids_dynamic ) THEN 4195 4194 ! … … 4208 4207 ALLOCATE( vars_pids(1:num_var_pids) ) 4209 4208 CALL inquire_variable_names( pids_id, vars_pids ) 4210 ! 4211 !-- Read vertical dimension for soil depth. 4209 ! 4210 !-- Read vertical dimension for soil depth. 4212 4211 IF ( check_existence( vars_pids, 'zsoil' ) ) & 4213 4212 CALL get_dimension_length( pids_id, init_3d%nzs, 'zsoil' ) 4214 ! 4213 ! 4215 4214 !-- Read also the horizontal dimensions required for soil initialization. 4216 !-- Please note, in case of non-nested runs or in case of root domain, 4215 !-- Please note, in case of non-nested runs or in case of root domain, 4217 4216 !-- these data is already available, but will be read again for the sake 4218 !-- of clearness. 4217 !-- of clearness. 4219 4218 CALL get_dimension_length( pids_id, init_3d%nx, 'x' ) 4220 4219 CALL get_dimension_length( pids_id, init_3d%ny, 'y' ) 4221 ! 4220 ! 4222 4221 !-- Check for correct horizontal and vertical dimension. Please note, 4223 !-- in case of non-nested runs or in case of root domain, these checks 4222 !-- in case of non-nested runs or in case of root domain, these checks 4224 4223 !-- are already performed 4225 4224 IF ( init_3d%nx-1 /= nx .OR. init_3d%ny-1 /= ny ) THEN … … 4229 4228 CALL message( 'lsm_init', 'PA0543', 1, 2, 0, 6, 0 ) 4230 4229 ENDIF 4231 ! 4230 ! 4232 4231 !-- Read vertical dimensions. Later, these are required for eventual 4233 4232 !-- inter- and extrapolations of the initialization data. … … 4236 4235 CALL get_variable( pids_id, 'zsoil', init_3d%z_soil ) 4237 4236 ENDIF 4238 ! 4237 ! 4239 4238 !-- Read initial data for soil moisture 4240 4239 IF ( check_existence( vars_pids, 'init_soil_m' ) ) THEN 4241 ! 4240 ! 4242 4241 !-- Read attributes for the fill value and level-of-detail 4243 4242 CALL get_attribute( pids_id, char_fill, & … … 4247 4246 init_3d%lod_msoil, & 4248 4247 .FALSE., 'init_soil_m' ) 4249 ! 4248 ! 4250 4249 !-- level-of-detail 1 - read initialization profile 4251 4250 IF ( init_3d%lod_msoil == 1 ) THEN 4252 4251 ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) ) 4253 4252 4254 4253 CALL get_variable( pids_id, 'init_soil_m', & 4255 4254 init_3d%msoil_1d(0:init_3d%nzs-1) ) 4256 ! 4255 ! 4257 4256 !-- level-of-detail 2 - read 3D initialization data 4258 4257 ELSEIF ( init_3d%lod_msoil == 2 ) THEN 4259 4258 ALLOCATE ( init_3d%msoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr) ) 4260 4261 CALL get_variable( pids_id, 'init_soil_m', & 4259 4260 CALL get_variable( pids_id, 'init_soil_m', & 4262 4261 init_3d%msoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr),& 4263 4262 nxl, nxr, nys, nyn, 0, init_3d%nzs-1 ) 4264 4263 4265 4264 ENDIF 4266 4265 init_3d%from_file_msoil = .TRUE. 4267 4266 ENDIF 4268 ! 4267 ! 4269 4268 !-- Read soil temperature 4270 4269 IF ( check_existence( vars_pids, 'init_soil_t' ) ) THEN 4271 ! 4270 ! 4272 4271 !-- Read attributes for the fill value and level-of-detail 4273 4272 CALL get_attribute( pids_id, char_fill, & … … 4277 4276 init_3d%lod_tsoil, & 4278 4277 .FALSE., 'init_soil_t' ) 4279 ! 4278 ! 4280 4279 !-- level-of-detail 1 - read initialization profile 4281 4280 IF ( init_3d%lod_tsoil == 1 ) THEN 4282 4281 ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) ) 4283 4282 4284 4283 CALL get_variable( pids_id, 'init_soil_t', & 4285 4284 init_3d%tsoil_1d(0:init_3d%nzs-1) ) 4286 4287 ! 4285 4286 ! 4288 4287 !-- level-of-detail 2 - read 3D initialization data 4289 4288 ELSEIF ( init_3d%lod_tsoil == 2 ) THEN 4290 4289 ALLOCATE ( init_3d%tsoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr) ) 4291 4292 CALL get_variable( pids_id, 'init_soil_t', & 4290 4291 CALL get_variable( pids_id, 'init_soil_t', & 4293 4292 init_3d%tsoil_3d(0:init_3d%nzs-1,nys:nyn,nxl:nxr),& 4294 4293 nxl, nxr, nys, nyn, 0, init_3d%nzs-1 ) … … 4296 4295 init_3d%from_file_tsoil = .TRUE. 4297 4296 ENDIF 4298 ! 4297 ! 4299 4298 !-- Close the input file and deallocate temporary arrays 4300 4299 DEALLOCATE( vars_pids ) 4301 4300 4302 4301 CALL close_input_file( pids_id ) 4303 #endif 4304 ! 4302 #endif 4303 ! 4305 4304 !-- End of CPU measurement 4306 4305 CALL cpu_log( log_point_s(85), 'NetCDF input init', 'stop' ) 4307 4306 ENDIF 4308 4307 ! 4309 !-- In case no dynamic input is available for a child domain but the 4310 !-- parent is initialized with dynamic input file, the different soil 4311 !-- states can lead to significant discrepancies in the atmospheric 4308 !-- In case no dynamic input is available for a child domain but the 4309 !-- parent is initialized with dynamic input file, the different soil 4310 !-- states can lead to significant discrepancies in the atmospheric 4312 4311 !-- surface forcing. For this reason, the child domain is initialized with 4313 4312 !-- domain-averaged soil profiles from the root domain, even if 4314 !-- no initialization with inifor is set. Note, as long as a dynamic 4313 !-- no initialization with inifor is set. Note, as long as a dynamic 4315 4314 !-- input file with soil information is available for the child domain, 4316 4315 !-- the input file information will be used. … … 4318 4317 #if defined( __parallel ) 4319 4318 ! 4320 !-- Check if soil moisture and temperature in the root model are 4321 !-- initialized from dynamic input. This case, distribute these 4319 !-- Check if soil moisture and temperature in the root model are 4320 !-- initialized from dynamic input. This case, distribute these 4322 4321 !-- information to its child domain(s). 4323 4322 IF ( pmc_is_rootmodel() ) THEN 4324 init_msoil_from_driver_root = init_3d%from_file_msoil 4323 init_msoil_from_driver_root = init_3d%from_file_msoil 4325 4324 init_tsoil_from_driver_root = init_3d%from_file_tsoil 4326 4325 ENDIF … … 4331 4330 0, MPI_COMM_WORLD, ierr ) 4332 4331 ! 4333 !-- In case of a nested run, first average the soil profiles in the 4332 !-- In case of a nested run, first average the soil profiles in the 4334 4333 !-- root domain. 4335 4334 IF ( init_msoil_from_driver_root .OR. & … … 4338 4337 IF ( pmc_is_rootmodel() ) THEN 4339 4338 ! 4340 !-- Child domains will be only initialized with horizontally 4341 !-- averaged soil profiles in parent domain (for sake of simplicity). 4342 !-- If required, average soil data on root parent domain before the 4339 !-- Child domains will be only initialized with horizontally 4340 !-- averaged soil profiles in parent domain (for sake of simplicity). 4341 !-- If required, average soil data on root parent domain before the 4343 4342 !-- soil profiles are distributed onto the child domains. 4344 4343 !-- Start with soil moisture. … … 4349 4348 pr_soil_init(k) = SUM( init_3d%msoil_3d(k,nys:nyn,nxl:nxr) ) 4350 4349 ENDDO 4351 ! 4352 !-- Allocate 1D array for soil-moisture profile (will not be 4353 !-- allocated in lod==2 case). 4350 ! 4351 !-- Allocate 1D array for soil-moisture profile (will not be 4352 !-- allocated in lod==2 case). 4354 4353 ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) ) 4355 4354 init_3d%msoil_1d = 0.0_wp … … 4357 4356 SIZE(pr_soil_init), & 4358 4357 MPI_REAL, MPI_SUM, comm2d, ierr ) 4359 4358 4360 4359 init_3d%msoil_1d = init_3d%msoil_1d / & 4361 4360 REAL( ( nx + 1 ) * ( ny + 1), KIND=wp ) 4362 4361 DEALLOCATE( pr_soil_init ) 4363 4362 ENDIF 4364 ! 4363 ! 4365 4364 !-- Proceed with soil temperature. 4366 4365 IF ( init_3d%from_file_tsoil .AND. & 4367 4366 init_3d%lod_tsoil == 2 ) THEN 4368 4367 ALLOCATE( pr_soil_init(0:init_3d%nzs-1) ) 4369 4368 4370 4369 DO k = 0, init_3d%nzs-1 4371 4370 pr_soil_init(k) = SUM( init_3d%tsoil_3d(k,nys:nyn,nxl:nxr) ) 4372 4371 ENDDO 4373 ! 4374 !-- Allocate 1D array for soil-temperature profile (will not be 4375 !-- allocated in lod==2 case). 4372 ! 4373 !-- Allocate 1D array for soil-temperature profile (will not be 4374 !-- allocated in lod==2 case). 4376 4375 ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) ) 4377 4376 init_3d%tsoil_1d = 0.0_wp … … 4382 4381 REAL( ( nx + 1 ) * ( ny + 1), KIND=wp ) 4383 4382 DEALLOCATE( pr_soil_init ) 4384 4383 4385 4384 ENDIF 4386 4385 ENDIF 4387 ! 4388 !-- Broadcast number of soil layers in root model to all childs. 4389 !-- Note, only process 0 in COMM_WORLD is sending. 4386 ! 4387 !-- Broadcast number of soil layers in root model to all childs. 4388 !-- Note, only process 0 in COMM_WORLD is sending. 4390 4389 IF ( pmc_is_rootmodel() ) nzs_root = init_3d%nzs 4391 4390 4392 4391 CALL MPI_BCAST( nzs_root, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, ierr ) 4393 ! 4394 !-- Allocate dummy arrays for soil moisture and temperature profiles 4395 !-- on all domains. 4392 ! 4393 !-- Allocate dummy arrays for soil moisture and temperature profiles 4394 !-- on all domains. 4396 4395 ALLOCATE( z_soil_root(1:nzs_root) ) 4397 4396 IF ( init_msoil_from_driver_root ) & … … 4421 4420 ! 4422 4421 !-- In the following, the child domains decide whether they take 4423 !-- the information from the root domain or not. 4422 !-- the information from the root domain or not. 4424 4423 IF ( .NOT. pmc_is_rootmodel() ) THEN 4425 ! 4424 ! 4426 4425 !-- If soil moisture or temperature isn't in dynamic input file for 4427 !-- the child, take the information provided from the root model. 4426 !-- the child, take the information provided from the root model. 4428 4427 !-- Start with z-dimension 4429 4428 IF ( .NOT. init_3d%from_file_msoil .OR. & … … 4433 4432 init_3d%z_soil(1:init_3d%nzs) = z_soil_root 4434 4433 ENDIF 4435 ! 4436 !-- Take soil moisture. Note, control flags from_file... and LoD 4437 !-- need to be set. 4434 ! 4435 !-- Take soil moisture. Note, control flags from_file... and LoD 4436 !-- need to be set. 4438 4437 IF ( .NOT. init_3d%from_file_msoil ) THEN 4439 4438 ALLOCATE( init_3d%msoil_1d(0:init_3d%nzs-1) ) 4440 4439 init_3d%lod_msoil = 1 4441 4440 init_3d%from_file_msoil = .TRUE. 4442 4443 init_3d%msoil_1d = m_soil_root 4441 4442 init_3d%msoil_1d = m_soil_root 4444 4443 ENDIF 4445 ! 4446 !-- Take soil temperature. Note, control flags from_file... and LoD 4447 !-- need to be set. 4444 ! 4445 !-- Take soil temperature. Note, control flags from_file... and LoD 4446 !-- need to be set. 4448 4447 IF ( .NOT. init_3d%from_file_tsoil ) THEN 4449 4448 ALLOCATE( init_3d%tsoil_1d(0:init_3d%nzs-1) ) 4450 4449 init_3d%lod_tsoil = 1 4451 4450 init_3d%from_file_tsoil = .TRUE. 4452 4453 init_3d%tsoil_1d = t_soil_root 4451 4452 init_3d%tsoil_1d = t_soil_root 4454 4453 ENDIF 4455 4454 ENDIF 4456 4455 4457 4456 DEALLOCATE( z_soil_root ) 4458 4457 DEALLOCATE( m_soil_root ) … … 4462 4461 ENDIF 4463 4462 ! 4464 !-- Proceed with Level 2 initialization. 4463 !-- Proceed with Level 2 initialization. 4465 4464 IF ( init_3d%from_file_msoil ) THEN 4466 4465 … … 4516 4515 !-- input do not need to be checked whether a grid point 4517 4516 !-- is building covered. This is because soil data in the 4518 !-- dynamic input is provided for the whole domain. 4517 !-- dynamic input is provided for the whole domain. 4519 4518 i = surf_lsm_v(l)%i(m) 4520 4519 j = surf_lsm_v(l)%j(m) 4521 4520 4522 4521 IF ( init_3d%msoil_3d(0,j,i) /= init_3d%fill_msoil ) & 4523 4522 CALL interpolate_soil_profile( & … … 4575 4574 i = surf_lsm_h%i(m) 4576 4575 j = surf_lsm_h%j(m) 4577 4576 4578 4577 IF ( init_3d%tsoil_3d(0,j,i) /= init_3d%fill_tsoil ) & 4579 4578 CALL interpolate_soil_profile( & … … 4596 4595 !-- input do not need to be checked whether a grid point 4597 4596 !-- is building covered. This is because soil data in the 4598 !-- dynamic input is provided for the whole domain. 4597 !-- dynamic input is provided for the whole domain. 4599 4598 i = surf_lsm_v(l)%i(m) 4600 4599 j = surf_lsm_v(l)%j(m) 4601 4600 4602 4601 IF ( init_3d%tsoil_3d(0,j,i) /= init_3d%fill_tsoil ) & 4603 4602 CALL interpolate_soil_profile( & … … 4617 4616 ENDIF 4618 4617 ! 4619 !-- After soil moisture and temperature are finally initialized, check 4620 !-- if soil moisture is higher than its saturation value. If this would 4621 !-- be the case, the soil model parametrization will produce floating 4618 !-- After soil moisture and temperature are finally initialized, check 4619 !-- if soil moisture is higher than its saturation value. If this would 4620 !-- be the case, the soil model parametrization will produce floating 4622 4621 !-- point errors. Hence, limit the soil moisture to its saturation value 4623 !-- and give a warning. 4622 !-- and give a warning. 4624 4623 DO m = 1, surf_lsm_h%ns 4625 4624 IF ( surf_lsm_h%vegetation_surface(m) .OR. & … … 4633 4632 'thus limited to this value to maintain stability.' 4634 4633 CALL message( 'lsm_init', 'PA0458', 0, 1, myid, 6, 0 ) 4635 ENDIF 4634 ENDIF 4636 4635 ENDDO 4637 4636 ENDIF … … 4651 4650 ' and is ' // & 4652 4651 'thus limited to this value to maintain stability.' 4653 CALL message( 'lsm_init', 'PA0458', 0, 1, myid, 6, 0 ) 4652 CALL message( 'lsm_init', 'PA0458', 0, 1, myid, 6, 0 ) 4654 4653 ENDIF 4655 4654 ENDDO … … 4662 4661 DO m = 1, surf_lsm_h%ns 4663 4662 4664 i = surf_lsm_h%i(m) 4663 i = surf_lsm_h%i(m) 4665 4664 j = surf_lsm_h%j(m) 4666 4665 k = surf_lsm_h%k(m) … … 4670 4669 t_surface_h%var_1d(m) = t_soil_h%var_2d(nzb_soil,m) 4671 4670 surf_lsm_h%pt_surface(m) = t_soil_h%var_2d(nzb_soil,m) / exner(nzb) 4672 4671 4673 4672 IF ( bulk_cloud_model .OR. cloud_droplets ) THEN 4674 4673 surf_lsm_h%pt1(m) = pt(k,j,i) + lv_d_cp * d_exner(k) * ql(k,j,i) 4675 4674 ELSE 4676 4675 surf_lsm_h%pt1(m) = pt(k,j,i) 4677 ENDIF 4676 ENDIF 4678 4677 ! 4679 4678 !-- Assure that r_a cannot be zero at model start … … 4691 4690 DO l = 0, 3 4692 4691 DO m = 1, surf_lsm_v(l)%ns 4693 i = surf_lsm_v(l)%i(m) 4692 i = surf_lsm_v(l)%i(m) 4694 4693 j = surf_lsm_v(l)%j(m) 4695 k = surf_lsm_v(l)%k(m) 4694 k = surf_lsm_v(l)%k(m) 4696 4695 ! 4697 4696 !-- Initialize surface temperature with soil temperature in the uppermost … … 4704 4703 ELSE 4705 4704 surf_lsm_v(l)%pt1(m) = pt(k,j,i) 4706 ENDIF 4705 ENDIF 4707 4706 4708 4707 ! … … 4711 4710 surf_lsm_v(l)%pt1(m) = surf_lsm_v(l)%pt1(m) + 1.0E-20_wp 4712 4711 ! 4713 !-- Set artifical values for ts and us so that r_a has its initial value 4712 !-- Set artifical values for ts and us so that r_a has its initial value 4714 4713 !-- for the first time step. Only for interior core domain, not for ghost points 4715 4714 surf_lsm_v(l)%us(m) = 0.1_wp … … 4798 4797 !-- Map calculated root fractions 4799 4798 DO m = 1, surf_lsm_h%ns 4800 DO k = nzb_soil, nzt_soil 4799 DO k = nzb_soil, nzt_soil 4801 4800 IF ( surf_lsm_h%pavement_surface(m) .AND. & 4802 4801 k <= surf_lsm_h%nzt_pavement(m) ) THEN … … 4808 4807 ENDDO 4809 4808 ! 4810 !-- Normalize so that the sum = 1. Only relevant when the root 4809 !-- Normalize so that the sum = 1. Only relevant when the root 4811 4810 !-- distribution was set to zero due to pavement at some layers. 4812 4811 IF ( SUM( surf_lsm_h%root_fr(:,m) ) > 0.0_wp ) THEN … … 4828 4827 ENDDO 4829 4828 ! 4830 !-- Normalize so that the sum = 1. Only relevant when the root 4829 !-- Normalize so that the sum = 1. Only relevant when the root 4831 4830 !-- distribution was set to zero due to pavement at some layers. 4832 4831 IF ( SUM( surf_lsm_v(l)%root_fr(:,m) ) > 0.0_wp ) THEN 4833 DO k = nzb_soil, nzt_soil 4832 DO k = nzb_soil, nzt_soil 4834 4833 surf_lsm_v(l)%root_fr(k,m) = surf_lsm_v(l)%root_fr(k,m) & 4835 4834 / SUM( surf_lsm_v(l)%root_fr(:,m) ) … … 4846 4845 IF ( surf_lsm_h%vegetation_surface(m) ) THEN 4847 4846 i = surf_lsm_h%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 4848 surf_lsm_v(l)%building_covered(m) ) 4847 surf_lsm_v(l)%building_covered(m) ) 4849 4848 j = surf_lsm_h%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 4850 surf_lsm_v(l)%building_covered(m) ) 4851 DO k = nzb_soil, nzt_soil 4852 surf_lsm_h%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i) 4849 surf_lsm_v(l)%building_covered(m) ) 4850 DO k = nzb_soil, nzt_soil 4851 surf_lsm_h%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i) 4853 4852 ENDDO 4854 4853 … … 4860 4859 IF ( surf_lsm_v(l)%vegetation_surface(m) ) THEN 4861 4860 i = surf_lsm_v(l)%i(m) + MERGE( 0, surf_lsm_v(l)%ioff, & 4862 surf_lsm_v(l)%building_covered(m) ) 4861 surf_lsm_v(l)%building_covered(m) ) 4863 4862 j = surf_lsm_v(l)%j(m) + MERGE( 0, surf_lsm_v(l)%joff, & 4864 surf_lsm_v(l)%building_covered(m) ) 4865 4866 DO k = nzb_soil, nzt_soil 4867 surf_lsm_v(l)%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i) 4863 surf_lsm_v(l)%building_covered(m) ) 4864 4865 DO k = nzb_soil, nzt_soil 4866 surf_lsm_v(l)%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i) 4868 4867 ENDDO 4869 4868 … … 4873 4872 4874 4873 ENDIF 4875 4874 4876 4875 ! 4877 4876 !-- Possibly do user-defined actions (e.g. define heterogeneous land surface) … … 4880 4879 4881 4880 ! 4882 !-- Calculate new roughness lengths (for water surfaces only, i.e. only 4881 !-- Calculate new roughness lengths (for water surfaces only, i.e. only 4883 4882 !- horizontal surfaces) 4884 4883 IF ( .NOT. constant_roughness ) CALL calc_z0_water_surface … … 4896 4895 4897 4896 4898 !-- Store initial profiles of t_soil and m_soil (assuming they are 4897 !-- Store initial profiles of t_soil and m_soil (assuming they are 4899 4898 !-- horizontally homogeneous on this PE) 4900 4899 !-- DEACTIVATED FOR NOW - leads to error when number of locations with … … 4902 4901 ! hom(nzb_soil:nzt_soil,1,90,:) = SPREAD( t_soil_h%var_2d(nzb_soil:nzt_soil,1), & 4903 4902 ! 2, statistic_regions+1 ) 4904 ! hom(nzb_soil:nzt_soil,1,92,:) = SPREAD( m_soil_h%var_2d(nzb_soil:nzt_soil,1), & 4903 ! hom(nzb_soil:nzt_soil,1,92,:) = SPREAD( m_soil_h%var_2d(nzb_soil:nzt_soil,1), & 4905 4904 ! 2, statistic_regions+1 ) 4906 4905 4907 4906 ! 4908 !-- Finally, make some consistency checks. 4907 !-- Finally, make some consistency checks. 4909 4908 !-- Ceck for illegal combination of LAI and vegetation coverage. 4910 4909 IF ( ANY( .NOT. surf_lsm_h%pavement_surface .AND. & … … 4926 4925 ENDDO 4927 4926 ! 4928 !-- Check if roughness length for momentum, heat, or moisture exceed 4929 !-- surface-layer height and decrease local roughness length where 4927 !-- Check if roughness length for momentum, heat, or moisture exceed 4928 !-- surface-layer height and decrease local roughness length where 4930 4929 !-- necessary. This case, give an informative message. Note, to avoid 4931 4930 !-- that the job-protocoll is messed-up, this message is only given once. … … 5011 5010 !------------------------------------------------------------------------------! 5012 5011 SUBROUTINE lsm_init_arrays 5013 5012 5014 5013 5015 5014 IMPLICIT NONE 5016 5015 5017 INTEGER(iwp) :: l !< index indicating facing of surface array 5018 5016 INTEGER(iwp) :: l !< index indicating facing of surface array 5017 5019 5018 ALLOCATE ( root_extr(nzb_soil:nzt_soil) ) 5020 root_extr = 0.0_wp 5021 5022 ! 5023 !-- Allocate surface and soil temperature / humidity. Please note, 5019 root_extr = 0.0_wp 5020 5021 ! 5022 !-- Allocate surface and soil temperature / humidity. Please note, 5024 5023 !-- these arrays are allocated according to surface-data structure, 5025 !-- even if they do not belong to the data type due to the 5026 !-- pointer arithmetric (TARGET attribute is not allowed in a data-type). 5024 !-- even if they do not belong to the data type due to the 5025 !-- pointer arithmetric (TARGET attribute is not allowed in a data-type). 5027 5026 ! 5028 5027 !-- Horizontal surfaces … … 5063 5062 ALLOCATE ( tt_surface_h_m%var_1d(1:surf_lsm_h%ns) ) 5064 5063 ALLOCATE ( tm_soil_h_m%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ) 5065 ALLOCATE ( tt_soil_h_m%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ) 5064 ALLOCATE ( tt_soil_h_m%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ) 5066 5065 ! 5067 5066 !-- Horizontal surfaces … … 5071 5070 ALLOCATE ( tm_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 5072 5071 ALLOCATE ( tt_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) ) 5073 ENDDO 5072 ENDDO 5074 5073 5075 5074 ! … … 5091 5090 ALLOCATE ( surf_lsm_h%qsws_liq(1:surf_lsm_h%ns) ) 5092 5091 ALLOCATE ( surf_lsm_h%qsws_veg(1:surf_lsm_h%ns) ) 5093 ALLOCATE ( surf_lsm_h%rad_net_l(1:surf_lsm_h%ns) ) 5092 ALLOCATE ( surf_lsm_h%rad_net_l(1:surf_lsm_h%ns) ) 5094 5093 ALLOCATE ( surf_lsm_h%r_a(1:surf_lsm_h%ns) ) 5095 5094 ALLOCATE ( surf_lsm_h%r_canopy(1:surf_lsm_h%ns) ) … … 5103 5102 surf_lsm_h%water_surface = .FALSE. 5104 5103 surf_lsm_h%pavement_surface = .FALSE. 5105 surf_lsm_h%vegetation_surface = .FALSE. 5104 surf_lsm_h%vegetation_surface = .FALSE. 5106 5105 5107 5106 ! … … 5139 5138 surf_lsm_v(l)%water_surface = .FALSE. 5140 5139 surf_lsm_v(l)%pavement_surface = .FALSE. 5141 surf_lsm_v(l)%vegetation_surface = .FALSE. 5142 5140 surf_lsm_v(l)%vegetation_surface = .FALSE. 5141 5143 5142 5144 5143 ! 5145 5144 !-- Set default values 5146 5145 surf_lsm_v(l)%r_canopy_min = 0.0_wp 5147 5146 5148 5147 ENDDO 5149 5148 … … 5178 5177 IMPLICIT NONE 5179 5178 5180 CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file 5181 5179 CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file 5180 5182 5181 NAMELIST /lsm_par/ alpha_vangenuchten, c_surface, & 5183 5182 canopy_resistance_coefficient, & … … 5186 5185 deep_soil_temperature, & 5187 5186 dz_soil, & 5188 f_shortwave_incoming, field_capacity, & 5187 f_shortwave_incoming, field_capacity, & 5189 5188 aero_resist_kray, hydraulic_conductivity, & 5190 5189 lambda_surface_stable, & … … 5214 5213 deep_soil_temperature, & 5215 5214 dz_soil, & 5216 f_shortwave_incoming, field_capacity, & 5215 f_shortwave_incoming, field_capacity, & 5217 5216 aero_resist_kray, hydraulic_conductivity, & 5218 5217 lambda_surface_stable, & … … 5234 5233 z0h_water, z0q_water, z0_pavement, & 5235 5234 z0h_pavement, z0q_pavement 5236 5235 5237 5236 line = ' ' 5238 5237 5239 5238 ! 5240 5239 !-- Try to find land surface model package … … 5253 5252 !-- Set flag that indicates that the land surface model is switched on 5254 5253 land_surface = .TRUE. 5255 5254 5256 5255 GOTO 14 5257 5256 … … 5276 5275 'land_surface_parameters instead' 5277 5276 CALL message( 'lsm_parin', 'PA0487', 0, 1, 0, 6, 0 ) 5278 5277 5279 5278 ! 5280 5279 !-- Set flag that indicates that the land surface model is switched on 5281 5280 land_surface = .TRUE. 5282 5281 5283 5282 GOTO 14 5284 5283 … … 5289 5288 5290 5289 14 CONTINUE 5291 5290 5292 5291 5293 5292 END SUBROUTINE lsm_parin … … 5363 5362 IF ( surf%pavement_surface(m) .AND. & 5364 5363 k <= surf%nzt_pavement(m) ) THEN 5365 5364 5366 5365 surf%rho_c_total(k,m) = surf%rho_c_total_def(k,m) 5367 lambda_temp(k) = surf%lambda_h_def(k,m) 5368 5369 ELSE 5370 ! 5371 !-- Calculate volumetric heat capacity of the soil, taking 5372 !-- into account water content 5366 lambda_temp(k) = surf%lambda_h_def(k,m) 5367 5368 ELSE 5369 ! 5370 !-- Calculate volumetric heat capacity of the soil, taking 5371 !-- into account water content 5373 5372 surf%rho_c_total(k,m) = (rho_c_soil * & 5374 5373 ( 1.0_wp - surf%m_sat(k,m) ) & … … 5390 5389 5391 5390 ! 5392 !-- Calculate soil heat conductivity (lambda_h) at the _layer level 5391 !-- Calculate soil heat conductivity (lambda_h) at the _layer level 5393 5392 !-- using linear interpolation. For pavement surface, the 5394 5393 !-- true pavement depth is considered … … 5423 5422 surf_t_soil%var_2d(nzb_soil:nzt_soil,m) & 5424 5423 + dt_3d * ( tsc(2) & 5425 * tend(nzb_soil:nzt_soil) & 5424 * tend(nzb_soil:nzt_soil) & 5426 5425 + tsc(3) & 5427 5426 * surf_tt_soil_m%var_2d(nzb_soil:nzt_soil,m) ) … … 5448 5447 5449 5448 ! 5450 !-- In order to prevent water tranport through paved surfaces, 5449 !-- In order to prevent water tranport through paved surfaces, 5451 5450 !-- conductivity and diffusivity are set to zero 5452 5451 IF ( surf%pavement_surface(m) .AND. & … … 5454 5453 lambda_temp(k) = 0.0_wp 5455 5454 gamma_temp(k) = 0.0_wp 5456 5457 ELSE 5458 5455 5456 ELSE 5457 5459 5458 ! 5460 5459 !-- Calculate soil diffusivity at the center of the soil layers … … 5500 5499 IF ( humidity ) THEN 5501 5500 ! 5502 !-- Calculate soil diffusivity (lambda_w) at the _layer level 5501 !-- Calculate soil diffusivity (lambda_w) at the _layer level 5503 5502 !-- using linear interpolation. To do: replace this with 5504 5503 !-- ECMWF-IFS Eq. 8.81 5505 5504 DO k = nzb_soil, nzt_soil-1 5506 5505 5507 5506 surf%lambda_w(k,m) = ( lambda_temp(k+1) + lambda_temp(k) ) & 5508 5507 * 0.5_wp 5509 5508 surf%gamma_w(k,m) = ( gamma_temp(k+1) + gamma_temp(k) ) & 5510 5509 * 0.5_wp 5511 5510 5512 5511 ENDDO 5513 5512 ! 5514 5513 ! 5515 !-- In case of a closed bottom (= water content is conserved), 5516 !-- set hydraulic conductivity to zero to that no water will be 5514 !-- In case of a closed bottom (= water content is conserved), 5515 !-- set hydraulic conductivity to zero to that no water will be 5517 5516 !-- lost in the bottom layer. As gamma_w is always a positive value, 5518 5517 !-- it cannot be set to zero in case of purely dry soil since this … … 5525 5524 ELSE 5526 5525 surf%gamma_w(nzt_soil,m) = gamma_temp(nzt_soil) 5527 ENDIF 5528 5529 !-- The root extraction (= root_extr * qsws_veg / (rho_l 5530 !-- * l_v)) ensures the mass conservation for water. The 5531 !-- transpiration of plants equals the cumulative withdrawals by 5532 !-- the roots in the soil. The scheme takes into account the 5533 !-- availability of water in the soil layers as well as the root 5534 !-- fraction in the respective layer. Layer with moisture below 5535 !-- wilting point will not contribute, which reflects the 5526 ENDIF 5527 5528 !-- The root extraction (= root_extr * qsws_veg / (rho_l 5529 !-- * l_v)) ensures the mass conservation for water. The 5530 !-- transpiration of plants equals the cumulative withdrawals by 5531 !-- the roots in the soil. The scheme takes into account the 5532 !-- availability of water in the soil layers as well as the root 5533 !-- fraction in the respective layer. Layer with moisture below 5534 !-- wilting point will not contribute, which reflects the 5536 5535 !-- preference of plants to take water from moister layers. 5537 5536 ! 5538 !-- Calculate the root extraction (ECMWF 7.69, the sum of 5539 !-- root_extr = 1). The energy balance solver guarantees a 5540 !-- positive transpiration, so that there is no need for an 5537 !-- Calculate the root extraction (ECMWF 7.69, the sum of 5538 !-- root_extr = 1). The energy balance solver guarantees a 5539 !-- positive transpiration, so that there is no need for an 5541 5540 !-- additional check. 5542 5541 m_total = 0.0_wp … … 5546 5545 * surf_m_soil%var_2d(k,m) 5547 5546 ENDIF 5548 ENDDO 5547 ENDDO 5549 5548 IF ( m_total > 0.0_wp ) THEN 5550 5549 DO k = nzb_soil, nzt_soil … … 5587 5586 root_extr(nzt_soil) & 5588 5587 * surf%qsws_veg(m) * drho_l_lv ) & 5589 ) * ddz_soil(nzt_soil) 5588 ) * ddz_soil(nzt_soil) 5590 5589 5591 5590 surf_m_soil_p%var_2d(nzb_soil:nzt_soil,m) = & 5592 5591 surf_m_soil%var_2d(nzb_soil:nzt_soil,m) & 5593 5592 + dt_3d * ( tsc(2) * tend(:) & 5594 + tsc(3) * surf_tm_soil_m%var_2d(:,m) ) 5595 5593 + tsc(3) * surf_tm_soil_m%var_2d(:,m) ) 5594 5596 5595 ! 5597 5596 !-- Account for dry and wet soils to keep solution stable … … 5599 5598 DO k = nzb_soil, nzt_soil 5600 5599 surf_m_soil_p%var_2d(k,m) = MIN( surf_m_soil_p%var_2d(k,m), surf%m_sat(k,m) ) 5601 surf_m_soil_p%var_2d(k,m) = MAX( surf_m_soil_p%var_2d(k,m), 0.0_wp ) 5600 surf_m_soil_p%var_2d(k,m) = MAX( surf_m_soil_p%var_2d(k,m), 0.0_wp ) 5602 5601 ENDDO 5603 5602 5604 5603 ! 5605 5604 !-- Calculate m_soil tendencies for the next Runge-Kutta step … … 5618 5617 5619 5618 ENDIF 5620 5619 5621 5620 ENDIF 5622 5621 5623 5622 ENDIF 5624 5623 … … 5638 5637 END SUBROUTINE lsm_soil_model 5639 5638 5640 5639 5641 5640 !------------------------------------------------------------------------------! 5642 5641 ! Description: … … 5650 5649 INTEGER, INTENT(IN) :: mod_count 5651 5650 5652 5651 5653 5652 SELECT CASE ( mod_count ) 5654 5653 … … 5708 5707 !------------------------------------------------------------------------------! 5709 5708 SUBROUTINE lsm_3d_data_averaging( mode, variable ) 5710 5709 5711 5710 5712 5711 USE control_parameters … … 5716 5715 IMPLICIT NONE 5717 5716 5718 CHARACTER (LEN=*) :: mode !< 5719 CHARACTER (LEN=*) :: variable !< 5720 5721 INTEGER(iwp) :: i !< 5722 INTEGER(iwp) :: j !< 5723 INTEGER(iwp) :: k !< 5717 CHARACTER (LEN=*) :: mode !< 5718 CHARACTER (LEN=*) :: variable !< 5719 5720 INTEGER(iwp) :: i !< 5721 INTEGER(iwp) :: j !< 5722 INTEGER(iwp) :: k !< 5724 5723 INTEGER(iwp) :: m !< running index 5725 5724 … … 5804 5803 5805 5804 CASE ( 'c_liq*' ) 5806 IF ( ALLOCATED( c_liq_av ) ) THEN 5805 IF ( ALLOCATED( c_liq_av ) ) THEN 5807 5806 DO m = 1, surf_lsm_h%ns 5808 i = surf_lsm_h%i(m) 5807 i = surf_lsm_h%i(m) 5809 5808 j = surf_lsm_h%j(m) 5810 5809 c_liq_av(j,i) = c_liq_av(j,i) + surf_lsm_h%c_liq(m) 5811 5810 ENDDO 5812 ENDIF 5811 ENDIF 5813 5812 5814 5813 CASE ( 'c_soil*' ) 5815 IF ( ALLOCATED( c_soil_av ) ) THEN 5814 IF ( ALLOCATED( c_soil_av ) ) THEN 5816 5815 DO m = 1, surf_lsm_h%ns 5817 i = surf_lsm_h%i(m) 5816 i = surf_lsm_h%i(m) 5818 5817 j = surf_lsm_h%j(m) 5819 5818 c_soil_av(j,i) = c_soil_av(j,i) + (1.0 - surf_lsm_h%c_veg(m)) … … 5822 5821 5823 5822 CASE ( 'c_veg*' ) 5824 IF ( ALLOCATED( c_veg_av ) ) THEN 5823 IF ( ALLOCATED( c_veg_av ) ) THEN 5825 5824 DO m = 1, surf_lsm_h%ns 5826 i = surf_lsm_h%i(m) 5825 i = surf_lsm_h%i(m) 5827 5826 j = surf_lsm_h%j(m) 5828 5827 c_veg_av(j,i) = c_veg_av(j,i) + surf_lsm_h%c_veg(m) … … 5831 5830 5832 5831 CASE ( 'lai*' ) 5833 IF ( ALLOCATED( lai_av ) ) THEN 5832 IF ( ALLOCATED( lai_av ) ) THEN 5834 5833 DO m = 1, surf_lsm_h%ns 5835 i = surf_lsm_h%i(m) 5834 i = surf_lsm_h%i(m) 5836 5835 j = surf_lsm_h%j(m) 5837 5836 lai_av(j,i) = lai_av(j,i) + surf_lsm_h%lai(m) … … 5840 5839 5841 5840 CASE ( 'm_liq*' ) 5842 IF ( ALLOCATED( m_liq_av ) ) THEN 5841 IF ( ALLOCATED( m_liq_av ) ) THEN 5843 5842 DO m = 1, surf_lsm_h%ns 5844 i = surf_lsm_h%i(m) 5843 i = surf_lsm_h%i(m) 5845 5844 j = surf_lsm_h%j(m) 5846 5845 m_liq_av(j,i) = m_liq_av(j,i) + m_liq_h%var_1d(m) … … 5849 5848 5850 5849 CASE ( 'm_soil' ) 5851 IF ( ALLOCATED( m_soil_av ) ) THEN 5850 IF ( ALLOCATED( m_soil_av ) ) THEN 5852 5851 DO m = 1, surf_lsm_h%ns 5853 i = surf_lsm_h%i(m) 5852 i = surf_lsm_h%i(m) 5854 5853 j = surf_lsm_h%j(m) 5855 5854 DO k = nzb_soil, nzt_soil … … 5860 5859 5861 5860 CASE ( 'qsws_liq*' ) 5862 IF ( ALLOCATED( qsws_liq_av ) ) THEN 5861 IF ( ALLOCATED( qsws_liq_av ) ) THEN 5863 5862 DO m = 1, surf_lsm_h%ns 5864 i = surf_lsm_h%i(m) 5863 i = surf_lsm_h%i(m) 5865 5864 j = surf_lsm_h%j(m) 5866 5865 qsws_liq_av(j,i) = qsws_liq_av(j,i) + & … … 5870 5869 5871 5870 CASE ( 'qsws_soil*' ) 5872 IF ( ALLOCATED( qsws_soil_av ) ) THEN 5871 IF ( ALLOCATED( qsws_soil_av ) ) THEN 5873 5872 DO m = 1, surf_lsm_h%ns 5874 i = surf_lsm_h%i(m) 5873 i = surf_lsm_h%i(m) 5875 5874 j = surf_lsm_h%j(m) 5876 5875 qsws_soil_av(j,i) = qsws_soil_av(j,i) + & … … 5880 5879 5881 5880 CASE ( 'qsws_veg*' ) 5882 IF ( ALLOCATED(qsws_veg_av ) ) THEN 5881 IF ( ALLOCATED(qsws_veg_av ) ) THEN 5883 5882 DO m = 1, surf_lsm_h%ns 5884 i = surf_lsm_h%i(m) 5883 i = surf_lsm_h%i(m) 5885 5884 j = surf_lsm_h%j(m) 5886 5885 qsws_veg_av(j,i) = qsws_veg_av(j,i) + & … … 5890 5889 5891 5890 CASE ( 'r_s*' ) 5892 IF ( ALLOCATED( r_s_av) ) THEN 5891 IF ( ALLOCATED( r_s_av) ) THEN 5893 5892 DO m = 1, surf_lsm_h%ns 5894 i = surf_lsm_h%i(m) 5893 i = surf_lsm_h%i(m) 5895 5894 j = surf_lsm_h%j(m) 5896 5895 r_s_av(j,i) = r_s_av(j,i) + surf_lsm_h%r_s(m) … … 5899 5898 5900 5899 CASE ( 't_soil' ) 5901 IF ( ALLOCATED( t_soil_av ) ) THEN 5900 IF ( ALLOCATED( t_soil_av ) ) THEN 5902 5901 DO m = 1, surf_lsm_h%ns 5903 i = surf_lsm_h%i(m) 5902 i = surf_lsm_h%i(m) 5904 5903 j = surf_lsm_h%j(m) 5905 5904 DO k = nzb_soil, nzt_soil … … 5908 5907 ENDDO 5909 5908 ENDIF 5910 5909 5911 5910 CASE DEFAULT 5912 5911 CONTINUE … … 6014 6013 DO i = nxl, nxr 6015 6014 DO j = nys, nyn 6016 r_s_av(j,i) = r_s_av(j,i) & 6015 r_s_av(j,i) = r_s_av(j,i) & 6017 6016 / REAL( average_count_3d, KIND=wp ) 6018 6017 ENDDO … … 6032 6031 ENDIF 6033 6032 ! 6034 !-- 6033 !-- 6035 6034 6036 6035 END SELECT … … 6049 6048 !------------------------------------------------------------------------------! 6050 6049 SUBROUTINE lsm_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) 6051 6050 6052 6051 IMPLICIT NONE 6053 6052 6054 CHARACTER (LEN=*), INTENT(IN) :: var !< 6055 LOGICAL, INTENT(OUT) :: found !< 6056 CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< 6057 CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< 6058 CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< 6053 CHARACTER (LEN=*), INTENT(IN) :: var !< 6054 LOGICAL, INTENT(OUT) :: found !< 6055 CHARACTER (LEN=*), INTENT(OUT) :: grid_x !< 6056 CHARACTER (LEN=*), INTENT(OUT) :: grid_y !< 6057 CHARACTER (LEN=*), INTENT(OUT) :: grid_z !< 6059 6058 6060 6059 found = .TRUE. … … 6087 6086 SUBROUTINE lsm_data_output_2d( av, variable, found, grid, mode, local_pf, & 6088 6087 two_d, nzb_do, nzt_do ) 6089 6088 6090 6089 USE indices 6091 6090 … … 6093 6092 IMPLICIT NONE 6094 6093 6095 CHARACTER (LEN=*) :: grid !< 6096 CHARACTER (LEN=*) :: mode !< 6097 CHARACTER (LEN=*) :: variable !< 6098 6099 INTEGER(iwp) :: av !< 6100 INTEGER(iwp) :: i !< running index 6094 CHARACTER (LEN=*) :: grid !< 6095 CHARACTER (LEN=*) :: mode !< 6096 CHARACTER (LEN=*) :: variable !< 6097 6098 INTEGER(iwp) :: av !< 6099 INTEGER(iwp) :: i !< running index 6101 6100 INTEGER(iwp) :: j !< running index 6102 6101 INTEGER(iwp) :: k !< running index 6103 6102 INTEGER(iwp) :: m !< running index 6104 INTEGER(iwp) :: nzb_do !< 6105 INTEGER(iwp) :: nzt_do !< 6106 6107 LOGICAL :: found !< 6103 INTEGER(iwp) :: nzb_do !< 6104 INTEGER(iwp) :: nzt_do !< 6105 6106 LOGICAL :: found !< 6108 6107 LOGICAL :: two_d !< flag parameter that indicates 2D variables (horizontal cross sections) 6109 6108 6110 6109 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 6111 6110 6112 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 6111 REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb_do:nzt_do) :: local_pf !< 6113 6112 6114 6113 … … 6117 6116 SELECT CASE ( TRIM( variable ) ) 6118 6117 ! 6119 !-- Before data is transfered to local_pf, transfer is it 2D dummy variable and exchange ghost points therein. 6120 !-- However, at this point this is only required for instantaneous arrays, time-averaged quantities are already exchanged. 6118 !-- Before data is transfered to local_pf, transfer is it 2D dummy variable and exchange ghost points therein. 6119 !-- However, at this point this is only required for instantaneous arrays, time-averaged quantities are already exchanged. 6121 6120 CASE ( 'c_liq*_xy' ) ! 2d-array 6122 6121 IF ( av == 0 ) THEN 6123 6122 DO m = 1, surf_lsm_h%ns 6124 i = surf_lsm_h%i(m) 6123 i = surf_lsm_h%i(m) 6125 6124 j = surf_lsm_h%j(m) 6126 6125 local_pf(i,j,nzb+1) = surf_lsm_h%c_liq(m) * surf_lsm_h%c_veg(m) … … 6144 6143 IF ( av == 0 ) THEN 6145 6144 DO m = 1, surf_lsm_h%ns 6146 i = surf_lsm_h%i(m) 6145 i = surf_lsm_h%i(m) 6147 6146 j = surf_lsm_h%j(m) 6148 6147 local_pf(i,j,nzb+1) = 1.0_wp - surf_lsm_h%c_veg(m) … … 6166 6165 IF ( av == 0 ) THEN 6167 6166 DO m = 1, surf_lsm_h%ns 6168 i = surf_lsm_h%i(m) 6167 i = surf_lsm_h%i(m) 6169 6168 j = surf_lsm_h%j(m) 6170 6169 local_pf(i,j,nzb+1) = surf_lsm_h%c_veg(m) … … 6188 6187 IF ( av == 0 ) THEN 6189 6188 DO m = 1, surf_lsm_h%ns 6190 i = surf_lsm_h%i(m) 6189 i = surf_lsm_h%i(m) 6191 6190 j = surf_lsm_h%j(m) 6192 6191 local_pf(i,j,nzb+1) = surf_lsm_h%lai(m) … … 6210 6209 IF ( av == 0 ) THEN 6211 6210 DO m = 1, surf_lsm_h%ns 6212 i = surf_lsm_h%i(m) 6211 i = surf_lsm_h%i(m) 6213 6212 j = surf_lsm_h%j(m) 6214 6213 local_pf(i,j,nzb+1) = m_liq_h%var_1d(m) … … 6232 6231 IF ( av == 0 ) THEN 6233 6232 DO m = 1, surf_lsm_h%ns 6234 i = surf_lsm_h%i(m) 6233 i = surf_lsm_h%i(m) 6235 6234 j = surf_lsm_h%j(m) 6236 6235 DO k = nzb_soil, nzt_soil … … 6256 6255 6257 6256 IF ( mode == 'xy' ) grid = 'zs' 6258 6257 6259 6258 CASE ( 'qsws_liq*_xy' ) ! 2d-array 6260 6259 IF ( av == 0 ) THEN 6261 6260 DO m = 1, surf_lsm_h%ns 6262 i = surf_lsm_h%i(m) 6261 i = surf_lsm_h%i(m) 6263 6262 j = surf_lsm_h%j(m) 6264 6263 local_pf(i,j,nzb+1) = surf_lsm_h%qsws_liq(m) … … 6270 6269 ENDIF 6271 6270 DO i = nxl, nxr 6272 DO j = nys, nyn 6271 DO j = nys, nyn 6273 6272 local_pf(i,j,nzb+1) = qsws_liq_av(j,i) 6274 6273 ENDDO … … 6282 6281 IF ( av == 0 ) THEN 6283 6282 DO m = 1, surf_lsm_h%ns 6284 i = surf_lsm_h%i(m) 6283 i = surf_lsm_h%i(m) 6285 6284 j = surf_lsm_h%j(m) 6286 6285 local_pf(i,j,nzb+1) = surf_lsm_h%qsws_soil(m) … … 6292 6291 ENDIF 6293 6292 DO i = nxl, nxr 6294 DO j = nys, nyn 6293 DO j = nys, nyn 6295 6294 local_pf(i,j,nzb+1) = qsws_soil_av(j,i) 6296 6295 ENDDO … … 6304 6303 IF ( av == 0 ) THEN 6305 6304 DO m = 1, surf_lsm_h%ns 6306 i = surf_lsm_h%i(m) 6305 i = surf_lsm_h%i(m) 6307 6306 j = surf_lsm_h%j(m) 6308 6307 local_pf(i,j,nzb+1) = surf_lsm_h%qsws_veg(m) … … 6314 6313 ENDIF 6315 6314 DO i = nxl, nxr 6316 DO j = nys, nyn 6315 DO j = nys, nyn 6317 6316 local_pf(i,j,nzb+1) = qsws_veg_av(j,i) 6318 6317 ENDDO … … 6327 6326 IF ( av == 0 ) THEN 6328 6327 DO m = 1, surf_lsm_h%ns 6329 i = surf_lsm_h%i(m) 6328 i = surf_lsm_h%i(m) 6330 6329 j = surf_lsm_h%j(m) 6331 6330 local_pf(i,j,nzb+1) = surf_lsm_h%r_s(m) … … 6349 6348 IF ( av == 0 ) THEN 6350 6349 DO m = 1, surf_lsm_h%ns 6351 i = surf_lsm_h%i(m) 6350 i = surf_lsm_h%i(m) 6352 6351 j = surf_lsm_h%j(m) 6353 6352 DO k = nzb_soil, nzt_soil … … 6380 6379 6381 6380 END SELECT 6382 6381 6383 6382 END SUBROUTINE lsm_data_output_2d 6384 6383 … … 6391 6390 !------------------------------------------------------------------------------! 6392 6391 SUBROUTINE lsm_data_output_3d( av, variable, found, local_pf ) 6393 6392 6394 6393 6395 6394 USE indices … … 6398 6397 IMPLICIT NONE 6399 6398 6400 CHARACTER (LEN=*) :: variable !< 6401 6402 INTEGER(iwp) :: av !< 6403 INTEGER(iwp) :: i !< 6404 INTEGER(iwp) :: j !< 6405 INTEGER(iwp) :: k !< 6399 CHARACTER (LEN=*) :: variable !< 6400 6401 INTEGER(iwp) :: av !< 6402 INTEGER(iwp) :: i !< 6403 INTEGER(iwp) :: j !< 6404 INTEGER(iwp) :: k !< 6406 6405 INTEGER(iwp) :: m !< running index 6407 6406 6408 LOGICAL :: found !< 6407 LOGICAL :: found !< 6409 6408 6410 6409 REAL(wp) :: fill_value = -999.0_wp !< value for the _FillValue attribute 6411 6410 6412 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_soil:nzt_soil) :: local_pf !< 6411 REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb_soil:nzt_soil) :: local_pf !< 6413 6412 6414 6413 … … 6424 6423 IF ( av == 0 ) THEN 6425 6424 DO m = 1, surf_lsm_h%ns 6426 i = surf_lsm_h%i(m) 6425 i = surf_lsm_h%i(m) 6427 6426 j = surf_lsm_h%j(m) 6428 6427 DO k = nzb_soil, nzt_soil … … 6448 6447 IF ( av == 0 ) THEN 6449 6448 DO m = 1, surf_lsm_h%ns 6450 i = surf_lsm_h%i(m) 6449 i = surf_lsm_h%i(m) 6451 6450 j = surf_lsm_h%j(m) 6452 6451 DO k = nzb_soil, nzt_soil … … 6482 6481 ! Description: 6483 6482 ! ------------ 6484 !> Write restart data for land surface model. It is necessary to write 6483 !> Write restart data for land surface model. It is necessary to write 6485 6484 !> start_index and end_index several times. 6486 6485 !------------------------------------------------------------------------------! 6487 6486 SUBROUTINE lsm_wrd_local 6488 6487 6489 6488 6490 6489 IMPLICIT NONE … … 6544 6543 WRITE ( 14 ) qsws_veg_av 6545 6544 ENDIF 6546 6545 6547 6546 IF ( ALLOCATED( t_soil_av ) ) THEN 6548 6547 CALL wrd_write_string( 't_soil_av' ) … … 6558 6557 CALL wrd_write_string( 't_soil_h' ) 6559 6558 WRITE ( 14 ) t_soil_h%var_2d 6560 6561 6562 6559 6560 6561 6563 6562 DO l = 0, 3 6564 6563 … … 6569 6568 WRITE ( 14 ) surf_lsm_v(l)%end_index 6570 6569 6571 WRITE( dum, '(I1)') l 6570 WRITE( dum, '(I1)') l 6572 6571 6573 6572 CALL wrd_write_string( 't_soil_v(' // dum // ')' ) 6574 6573 WRITE ( 14 ) t_soil_v(l)%var_2d 6575 6574 6576 6575 ENDDO 6577 6576 … … 6593 6592 WRITE ( 14 ) surf_lsm_v(l)%end_index 6594 6593 6595 WRITE( dum, '(I1)') l 6594 WRITE( dum, '(I1)') l 6596 6595 6597 6596 CALL wrd_write_string( 'm_soil_v(' // dum // ')' ) 6598 WRITE ( 14 ) m_soil_v(l)%var_2d 6599 6597 WRITE ( 14 ) m_soil_v(l)%var_2d 6598 6600 6599 ENDDO 6601 6600 … … 6608 6607 CALL wrd_write_string( 'm_liq_h' ) 6609 6608 WRITE ( 14 ) m_liq_h%var_1d 6610 6609 6611 6610 DO l = 0, 3 6612 6611 … … 6617 6616 WRITE ( 14 ) surf_lsm_v(l)%end_index 6618 6617 6619 WRITE( dum, '(I1)') l 6618 WRITE( dum, '(I1)') l 6620 6619 6621 6620 CALL wrd_write_string( 'm_liq_v(' // dum // ')' ) 6622 WRITE ( 14 ) m_liq_v(l)%var_1d 6623 6621 WRITE ( 14 ) m_liq_v(l)%var_1d 6622 6624 6623 ENDDO 6625 6624 … … 6641 6640 WRITE ( 14 ) surf_lsm_v(l)%end_index 6642 6641 6643 WRITE( dum, '(I1)') l 6642 WRITE( dum, '(I1)') l 6644 6643 6645 6644 CALL wrd_write_string( 't_surface_v(' // dum // ')' ) 6646 WRITE ( 14 ) t_surface_v(l)%var_1d 6647 6645 WRITE ( 14 ) t_surface_v(l)%var_1d 6646 6648 6647 ENDDO 6649 6648 … … 6661 6660 nxr_on_file, nynf, nync, nyn_on_file, nysf, nysc, & 6662 6661 nys_on_file, tmp_2d, found ) 6663 6662 6664 6663 6665 6664 USE control_parameters 6666 6665 6667 6666 USE indices 6668 6667 6669 6668 USE pegrid 6670 6669 … … 6672 6671 IMPLICIT NONE 6673 6672 6674 INTEGER(iwp) :: k !< 6673 INTEGER(iwp) :: k !< 6675 6674 INTEGER(iwp) :: l !< running index surface orientation 6676 6675 INTEGER(iwp) :: ns_h_on_file_lsm !< number of horizontal surface elements (natural type) on file 6677 INTEGER(iwp) :: nxlc !< 6678 INTEGER(iwp) :: nxlf !< 6676 INTEGER(iwp) :: nxlc !< 6677 INTEGER(iwp) :: nxlf !< 6679 6678 INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain 6680 INTEGER(iwp) :: nxrc !< 6681 INTEGER(iwp) :: nxrf !< 6679 INTEGER(iwp) :: nxrc !< 6680 INTEGER(iwp) :: nxrf !< 6682 6681 INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain 6683 INTEGER(iwp) :: nync !< 6684 INTEGER(iwp) :: nynf !< 6682 INTEGER(iwp) :: nync !< 6683 INTEGER(iwp) :: nynf !< 6685 6684 INTEGER(iwp) :: nyn_on_file !< index of north boundary on former local domain 6686 INTEGER(iwp) :: nysc !< 6687 INTEGER(iwp) :: nysf !< 6685 INTEGER(iwp) :: nysc !< 6686 INTEGER(iwp) :: nysf !< 6688 6687 INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain 6689 6688 6690 6689 INTEGER(iwp) :: ns_v_on_file_lsm(0:3) !< number of vertical surface elements (natural type) on file 6691 6690 6692 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE :: start_index_on_file 6691 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE :: start_index_on_file 6693 6692 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, SAVE :: end_index_on_file 6694 6693 6695 6694 LOGICAL, INTENT(OUT) :: found 6696 6695 6697 REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d !< 6696 REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_2d !< 6698 6697 6699 6698 REAL(wp), DIMENSION(nzb_soil:nzt_soil,nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: tmp_3d !< … … 6701 6700 TYPE(surf_type_lsm), SAVE :: tmp_walltype_h_1d !< temporary 1D array containing the respective surface variable stored on file, horizontal surfaces 6702 6701 TYPE(surf_type_lsm), SAVE :: tmp_walltype_h_2d !< temporary 2D array containing the respective surface variable stored on file, horizontal surfaces 6703 TYPE(surf_type_lsm), SAVE :: tmp_walltype_h_2d2 !< temporary 2D array containing the respective surface variable stored on file, horizontal surfaces 6704 6705 TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_1d !< temporary 1D array containing the respective surface variable stored on file, vertical surfaces 6706 TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_2d !< temporary 2D array containing the respective surface variable stored on file, vertical surfaces 6702 TYPE(surf_type_lsm), SAVE :: tmp_walltype_h_2d2 !< temporary 2D array containing the respective surface variable stored on file, horizontal surfaces 6703 6704 TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_1d !< temporary 1D array containing the respective surface variable stored on file, vertical surfaces 6705 TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_2d !< temporary 2D array containing the respective surface variable stored on file, vertical surfaces 6707 6706 TYPE(surf_type_lsm), DIMENSION(0:3), SAVE :: tmp_walltype_v_2d2 !< temporary 2D array containing the respective surface variable stored on file, vertical surfaces 6708 6707 … … 6714 6713 6715 6714 CASE ( 'ns_h_on_file_lsm' ) 6716 IF ( k == 1 ) THEN 6715 IF ( k == 1 ) THEN 6717 6716 READ ( 13 ) ns_h_on_file_lsm 6718 6717 6719 6718 IF ( ALLOCATED( tmp_walltype_h_1d%var_1d ) ) & 6720 DEALLOCATE( tmp_walltype_h_1d%var_1d ) 6719 DEALLOCATE( tmp_walltype_h_1d%var_1d ) 6721 6720 IF ( ALLOCATED( tmp_walltype_h_2d%var_2d ) ) & 6722 DEALLOCATE( tmp_walltype_h_2d%var_2d ) 6721 DEALLOCATE( tmp_walltype_h_2d%var_2d ) 6723 6722 IF ( ALLOCATED( tmp_walltype_h_2d2%var_2d ) ) & 6724 DEALLOCATE( tmp_walltype_h_2d2%var_2d ) 6725 6726 ! 6727 !-- Allocate temporary arrays to store surface data 6728 ALLOCATE( tmp_walltype_h_1d%var_1d(1:ns_h_on_file_lsm) ) 6723 DEALLOCATE( tmp_walltype_h_2d2%var_2d ) 6724 6725 ! 6726 !-- Allocate temporary arrays to store surface data 6727 ALLOCATE( tmp_walltype_h_1d%var_1d(1:ns_h_on_file_lsm) ) 6729 6728 ALLOCATE( tmp_walltype_h_2d%var_2d(nzb_soil:nzt_soil+1, & 6730 1:ns_h_on_file_lsm) ) 6729 1:ns_h_on_file_lsm) ) 6731 6730 ALLOCATE( tmp_walltype_h_2d2%var_2d(nzb_soil:nzt_soil, & 6732 1:ns_h_on_file_lsm) ) 6733 6734 ENDIF 6735 6736 CASE ( 'ns_v_on_file_lsm' ) 6737 IF ( k == 1 ) THEN 6738 READ ( 13 ) ns_v_on_file_lsm 6739 6740 DO l = 0, 3 6731 1:ns_h_on_file_lsm) ) 6732 6733 ENDIF 6734 6735 CASE ( 'ns_v_on_file_lsm' ) 6736 IF ( k == 1 ) THEN 6737 READ ( 13 ) ns_v_on_file_lsm 6738 6739 DO l = 0, 3 6741 6740 IF ( ALLOCATED( tmp_walltype_v_1d(l)%var_1d ) ) & 6742 DEALLOCATE( tmp_walltype_v_1d(l)%var_1d ) 6741 DEALLOCATE( tmp_walltype_v_1d(l)%var_1d ) 6743 6742 IF ( ALLOCATED( tmp_walltype_v_2d(l)%var_2d ) ) & 6744 DEALLOCATE( tmp_walltype_v_2d(l)%var_2d ) 6743 DEALLOCATE( tmp_walltype_v_2d(l)%var_2d ) 6745 6744 IF ( ALLOCATED( tmp_walltype_v_2d2(l)%var_2d ) ) & 6746 DEALLOCATE( tmp_walltype_v_2d2(l)%var_2d ) 6747 ENDDO 6748 6749 ! 6750 !-- Allocate temporary arrays to store surface data 6751 DO l = 0, 3 6745 DEALLOCATE( tmp_walltype_v_2d2(l)%var_2d ) 6746 ENDDO 6747 6748 ! 6749 !-- Allocate temporary arrays to store surface data 6750 DO l = 0, 3 6752 6751 ALLOCATE( tmp_walltype_v_1d(l) & 6753 %var_1d(1:ns_v_on_file_lsm(l)) ) 6752 %var_1d(1:ns_v_on_file_lsm(l)) ) 6754 6753 ALLOCATE( tmp_walltype_v_2d(l) & 6755 6754 %var_2d(nzb_soil:nzt_soil+1, & 6756 1:ns_v_on_file_lsm(l)) ) 6755 1:ns_v_on_file_lsm(l)) ) 6757 6756 ALLOCATE( tmp_walltype_v_2d2(l) & 6758 6757 %var_2d(nzb_soil:nzt_soil, & 6759 1:ns_v_on_file_lsm(l)) ) 6760 ENDDO 6761 6762 ENDIF 6763 6764 6765 CASE ( 'c_liq_av' ) 6766 IF ( .NOT. ALLOCATED( c_liq_av ) ) THEN 6767 ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) ) 6768 ENDIF 6769 IF ( k == 1 ) READ ( 13 ) tmp_2d 6758 1:ns_v_on_file_lsm(l)) ) 6759 ENDDO 6760 6761 ENDIF 6762 6763 6764 CASE ( 'c_liq_av' ) 6765 IF ( .NOT. ALLOCATED( c_liq_av ) ) THEN 6766 ALLOCATE( c_liq_av(nysg:nyng,nxlg:nxrg) ) 6767 ENDIF 6768 IF ( k == 1 ) READ ( 13 ) tmp_2d 6770 6769 c_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6771 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6772 6773 CASE ( 'c_soil_av' ) 6774 IF ( .NOT. ALLOCATED( c_soil_av ) ) THEN 6775 ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) ) 6776 ENDIF 6777 IF ( k == 1 ) READ ( 13 ) tmp_2d 6770 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6771 6772 CASE ( 'c_soil_av' ) 6773 IF ( .NOT. ALLOCATED( c_soil_av ) ) THEN 6774 ALLOCATE( c_soil_av(nysg:nyng,nxlg:nxrg) ) 6775 ENDIF 6776 IF ( k == 1 ) READ ( 13 ) tmp_2d 6778 6777 c_soil_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6779 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6780 6781 CASE ( 'c_veg_av' ) 6782 IF ( .NOT. ALLOCATED( c_veg_av ) ) THEN 6783 ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) ) 6784 ENDIF 6785 IF ( k == 1 ) READ ( 13 ) tmp_2d 6778 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6779 6780 CASE ( 'c_veg_av' ) 6781 IF ( .NOT. ALLOCATED( c_veg_av ) ) THEN 6782 ALLOCATE( c_veg_av(nysg:nyng,nxlg:nxrg) ) 6783 ENDIF 6784 IF ( k == 1 ) READ ( 13 ) tmp_2d 6786 6785 c_veg_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6787 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6788 6789 CASE ( 'lai_av' ) 6790 IF ( .NOT. ALLOCATED( lai_av ) ) THEN 6791 ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) ) 6792 ENDIF 6793 IF ( k == 1 ) READ ( 13 ) tmp_2d 6786 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6787 6788 CASE ( 'lai_av' ) 6789 IF ( .NOT. ALLOCATED( lai_av ) ) THEN 6790 ALLOCATE( lai_av(nysg:nyng,nxlg:nxrg) ) 6791 ENDIF 6792 IF ( k == 1 ) READ ( 13 ) tmp_2d 6794 6793 lai_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6795 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6796 6797 CASE ( 'm_liq_av' ) 6798 IF ( .NOT. ALLOCATED( m_liq_av ) ) THEN 6799 ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) ) 6800 ENDIF 6801 IF ( k == 1 ) READ ( 13 ) tmp_2d 6794 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6795 6796 CASE ( 'm_liq_av' ) 6797 IF ( .NOT. ALLOCATED( m_liq_av ) ) THEN 6798 ALLOCATE( m_liq_av(nysg:nyng,nxlg:nxrg) ) 6799 ENDIF 6800 IF ( k == 1 ) READ ( 13 ) tmp_2d 6802 6801 m_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6803 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6804 6805 CASE ( 'm_soil_av' ) 6806 IF ( .NOT. ALLOCATED( m_soil_av ) ) THEN 6807 ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ) 6808 ENDIF 6809 IF ( k == 1 ) READ ( 13 ) tmp_3d(:,:,:) 6802 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6803 6804 CASE ( 'm_soil_av' ) 6805 IF ( .NOT. ALLOCATED( m_soil_av ) ) THEN 6806 ALLOCATE( m_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ) 6807 ENDIF 6808 IF ( k == 1 ) READ ( 13 ) tmp_3d(:,:,:) 6810 6809 m_soil_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6811 6810 tmp_3d(nzb_soil:nzt_soil,nysf & 6812 -nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6813 6814 CASE ( 'qsws_liq_av' ) 6815 IF ( .NOT. ALLOCATED( qsws_liq_av ) ) THEN 6816 ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) ) 6817 ENDIF 6818 IF ( k == 1 ) READ ( 13 ) tmp_2d 6811 -nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6812 6813 CASE ( 'qsws_liq_av' ) 6814 IF ( .NOT. ALLOCATED( qsws_liq_av ) ) THEN 6815 ALLOCATE( qsws_liq_av(nysg:nyng,nxlg:nxrg) ) 6816 ENDIF 6817 IF ( k == 1 ) READ ( 13 ) tmp_2d 6819 6818 qsws_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6820 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6821 CASE ( 'qsws_soil_av' ) 6822 IF ( .NOT. ALLOCATED( qsws_soil_av ) ) THEN 6823 ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) ) 6824 ENDIF 6825 IF ( k == 1 ) READ ( 13 ) tmp_2d 6819 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6820 CASE ( 'qsws_soil_av' ) 6821 IF ( .NOT. ALLOCATED( qsws_soil_av ) ) THEN 6822 ALLOCATE( qsws_soil_av(nysg:nyng,nxlg:nxrg) ) 6823 ENDIF 6824 IF ( k == 1 ) READ ( 13 ) tmp_2d 6826 6825 qsws_soil_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6827 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6828 6829 CASE ( 'qsws_veg_av' ) 6830 IF ( .NOT. ALLOCATED( qsws_veg_av ) ) THEN 6831 ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) ) 6832 ENDIF 6833 IF ( k == 1 ) READ ( 13 ) tmp_2d 6826 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6827 6828 CASE ( 'qsws_veg_av' ) 6829 IF ( .NOT. ALLOCATED( qsws_veg_av ) ) THEN 6830 ALLOCATE( qsws_veg_av(nysg:nyng,nxlg:nxrg) ) 6831 ENDIF 6832 IF ( k == 1 ) READ ( 13 ) tmp_2d 6834 6833 qsws_veg_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6835 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6836 6837 CASE ( 't_soil_av' ) 6838 IF ( .NOT. ALLOCATED( t_soil_av ) ) THEN 6839 ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ) 6840 ENDIF 6841 IF ( k == 1 ) READ ( 13 ) tmp_3d(:,:,:) 6834 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6835 6836 CASE ( 't_soil_av' ) 6837 IF ( .NOT. ALLOCATED( t_soil_av ) ) THEN 6838 ALLOCATE( t_soil_av(nzb_soil:nzt_soil,nysg:nyng,nxlg:nxrg) ) 6839 ENDIF 6840 IF ( k == 1 ) READ ( 13 ) tmp_3d(:,:,:) 6842 6841 t_soil_av(:,nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) = & 6843 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6844 6845 CASE ( 'lsm_start_index_h', 'lsm_start_index_v' ) 6846 IF ( k == 1 ) THEN 6847 6842 tmp_3d(:,nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp) 6843 6844 CASE ( 'lsm_start_index_h', 'lsm_start_index_v' ) 6845 IF ( k == 1 ) THEN 6846 6848 6847 IF ( ALLOCATED( start_index_on_file ) ) & 6849 DEALLOCATE( start_index_on_file ) 6850 6848 DEALLOCATE( start_index_on_file ) 6849 6851 6850 ALLOCATE ( start_index_on_file(nys_on_file:nyn_on_file, & 6852 nxl_on_file:nxr_on_file) ) 6853 6854 READ ( 13 ) start_index_on_file 6855 6856 ENDIF 6857 6858 CASE ( 'lsm_end_index_h', 'lsm_end_index_v' ) 6859 IF ( k == 1 ) THEN 6860 6851 nxl_on_file:nxr_on_file) ) 6852 6853 READ ( 13 ) start_index_on_file 6854 6855 ENDIF 6856 6857 CASE ( 'lsm_end_index_h', 'lsm_end_index_v' ) 6858 IF ( k == 1 ) THEN 6859 6861 6860 IF ( ALLOCATED( end_index_on_file ) ) & 6862 DEALLOCATE( end_index_on_file ) 6863 6861 DEALLOCATE( end_index_on_file ) 6862 6864 6863 ALLOCATE ( end_index_on_file(nys_on_file:nyn_on_file, & 6865 nxl_on_file:nxr_on_file) ) 6866 6867 READ ( 13 ) end_index_on_file 6868 6869 ENDIF 6870 6871 CASE ( 't_soil_h' ) 6872 6873 IF ( k == 1 ) THEN 6864 nxl_on_file:nxr_on_file) ) 6865 6866 READ ( 13 ) end_index_on_file 6867 6868 ENDIF 6869 6870 CASE ( 't_soil_h' ) 6871 6872 IF ( k == 1 ) THEN 6874 6873 IF ( .NOT. ALLOCATED( t_soil_h%var_2d ) ) & 6875 6874 ALLOCATE( t_soil_h%var_2d(nzb_soil:nzt_soil+1, & 6876 1:surf_lsm_h%ns) ) 6877 READ ( 13 ) tmp_walltype_h_2d%var_2d 6878 ENDIF 6875 1:surf_lsm_h%ns) ) 6876 READ ( 13 ) tmp_walltype_h_2d%var_2d 6877 ENDIF 6879 6878 CALL surface_restore_elements( & 6880 6879 t_soil_h%var_2d, & 6881 6880 tmp_walltype_h_2d%var_2d, & 6882 surf_lsm_h%start_index, & 6881 surf_lsm_h%start_index, & 6883 6882 start_index_on_file, & 6884 6883 end_index_on_file, & … … 6886 6885 nxlf, nxrf, nysf, nynf, & 6887 6886 nys_on_file, nyn_on_file, & 6888 nxl_on_file,nxr_on_file ) 6889 6890 CASE ( 't_soil_v(0)' ) 6891 6892 IF ( k == 1 ) THEN 6887 nxl_on_file,nxr_on_file ) 6888 6889 CASE ( 't_soil_v(0)' ) 6890 6891 IF ( k == 1 ) THEN 6893 6892 IF ( .NOT. ALLOCATED( t_soil_v(0)%var_2d ) ) & 6894 6893 ALLOCATE( t_soil_v(0)%var_2d(nzb_soil:nzt_soil+1, & 6895 1:surf_lsm_v(0)%ns) ) 6896 READ ( 13 ) tmp_walltype_v_2d(0)%var_2d 6897 ENDIF 6894 1:surf_lsm_v(0)%ns) ) 6895 READ ( 13 ) tmp_walltype_v_2d(0)%var_2d 6896 ENDIF 6898 6897 CALL surface_restore_elements( & 6899 6898 t_soil_v(0)%var_2d, & 6900 6899 tmp_walltype_v_2d(0)%var_2d, & 6901 surf_lsm_v(0)%start_index, & 6900 surf_lsm_v(0)%start_index, & 6902 6901 start_index_on_file, & 6903 6902 end_index_on_file, & … … 6905 6904 nxlf, nxrf, nysf, nynf, & 6906 6905 nys_on_file, nyn_on_file, & 6907 nxl_on_file,nxr_on_file ) 6908 6909 CASE ( 't_soil_v(1)' ) 6910 6911 IF ( k == 1 ) THEN 6906 nxl_on_file,nxr_on_file ) 6907 6908 CASE ( 't_soil_v(1)' ) 6909 6910 IF ( k == 1 ) THEN 6912 6911 IF ( .NOT. ALLOCATED( t_soil_v(1)%var_2d ) ) & 6913 6912 ALLOCATE( t_soil_v(1)%var_2d(nzb_soil:nzt_soil+1, & 6914 1:surf_lsm_v(1)%ns) ) 6915 READ ( 13 ) tmp_walltype_v_2d(1)%var_2d 6916 ENDIF 6913 1:surf_lsm_v(1)%ns) ) 6914 READ ( 13 ) tmp_walltype_v_2d(1)%var_2d 6915 ENDIF 6917 6916 CALL surface_restore_elements( & 6918 6917 t_soil_v(1)%var_2d, & 6919 6918 tmp_walltype_v_2d(1)%var_2d, & 6920 surf_lsm_v(1)%start_index, & 6919 surf_lsm_v(1)%start_index, & 6921 6920 start_index_on_file, & 6922 6921 end_index_on_file, & … … 6924 6923 nxlf, nxrf, nysf, nynf, & 6925 6924 nys_on_file, nyn_on_file, & 6926 nxl_on_file,nxr_on_file ) 6927 6928 CASE ( 't_soil_v(2)' ) 6929 6930 IF ( k == 1 ) THEN 6925 nxl_on_file,nxr_on_file ) 6926 6927 CASE ( 't_soil_v(2)' ) 6928 6929 IF ( k == 1 ) THEN 6931 6930 IF ( .NOT. ALLOCATED( t_soil_v(2)%var_2d ) ) & 6932 6931 ALLOCATE( t_soil_v(2)%var_2d(nzb_soil:nzt_soil+1, & 6933 1:surf_lsm_v(2)%ns) ) 6934 READ ( 13 ) tmp_walltype_v_2d(2)%var_2d 6935 ENDIF 6932 1:surf_lsm_v(2)%ns) ) 6933 READ ( 13 ) tmp_walltype_v_2d(2)%var_2d 6934 ENDIF 6936 6935 CALL surface_restore_elements( & 6937 6936 t_soil_v(2)%var_2d, & 6938 6937 tmp_walltype_v_2d(2)%var_2d, & 6939 surf_lsm_v(2)%start_index, & 6938 surf_lsm_v(2)%start_index, & 6940 6939 start_index_on_file, & 6941 6940 end_index_on_file, & … … 6943 6942 nxlf, nxrf, nysf, nynf, & 6944 6943 nys_on_file, nyn_on_file, & 6945 nxl_on_file,nxr_on_file ) 6946 6947 CASE ( 't_soil_v(3)' ) 6948 6949 IF ( k == 1 ) THEN 6944 nxl_on_file,nxr_on_file ) 6945 6946 CASE ( 't_soil_v(3)' ) 6947 6948 IF ( k == 1 ) THEN 6950 6949 IF ( .NOT. ALLOCATED( t_soil_v(3)%var_2d ) ) & 6951 6950 ALLOCATE( t_soil_v(1)%var_2d(nzb_soil:nzt_soil+1, & 6952 1:surf_lsm_v(3)%ns) ) 6953 READ ( 13 ) tmp_walltype_v_2d(3)%var_2d 6954 ENDIF 6951 1:surf_lsm_v(3)%ns) ) 6952 READ ( 13 ) tmp_walltype_v_2d(3)%var_2d 6953 ENDIF 6955 6954 CALL surface_restore_elements( & 6956 6955 t_soil_v(3)%var_2d, & 6957 6956 tmp_walltype_v_2d(3)%var_2d, & 6958 surf_lsm_v(3)%start_index, & 6957 surf_lsm_v(3)%start_index, & 6959 6958 start_index_on_file, & 6960 6959 end_index_on_file, & … … 6962 6961 nxlf, nxrf, nysf, nynf, & 6963 6962 nys_on_file, nyn_on_file, & 6964 nxl_on_file,nxr_on_file ) 6965 6966 CASE ( 'm_soil_h' ) 6967 6968 IF ( k == 1 ) THEN 6963 nxl_on_file,nxr_on_file ) 6964 6965 CASE ( 'm_soil_h' ) 6966 6967 IF ( k == 1 ) THEN 6969 6968 IF ( .NOT. ALLOCATED( m_soil_h%var_2d ) ) & 6970 6969 ALLOCATE( m_soil_h%var_2d(nzb_soil:nzt_soil+1, & 6971 1:surf_lsm_h%ns) ) 6972 READ ( 13 ) tmp_walltype_h_2d2%var_2d 6973 ENDIF 6970 1:surf_lsm_h%ns) ) 6971 READ ( 13 ) tmp_walltype_h_2d2%var_2d 6972 ENDIF 6974 6973 CALL surface_restore_elements( & 6975 6974 m_soil_h%var_2d, & 6976 6975 tmp_walltype_h_2d2%var_2d, & 6977 surf_lsm_h%start_index, & 6976 surf_lsm_h%start_index, & 6978 6977 start_index_on_file, & 6979 6978 end_index_on_file, & … … 6981 6980 nxlf, nxrf, nysf, nynf, & 6982 6981 nys_on_file, nyn_on_file, & 6983 nxl_on_file,nxr_on_file ) 6984 6985 CASE ( 'm_soil_v(0)' ) 6986 6987 IF ( k == 1 ) THEN 6982 nxl_on_file,nxr_on_file ) 6983 6984 CASE ( 'm_soil_v(0)' ) 6985 6986 IF ( k == 1 ) THEN 6988 6987 IF ( .NOT. ALLOCATED( m_soil_v(0)%var_2d ) ) & 6989 6988 ALLOCATE( m_soil_v(0)%var_2d(nzb_soil:nzt_soil+1, & 6990 1:surf_lsm_v(0)%ns) ) 6991 READ ( 13 ) tmp_walltype_v_2d2(0)%var_2d 6992 ENDIF 6989 1:surf_lsm_v(0)%ns) ) 6990 READ ( 13 ) tmp_walltype_v_2d2(0)%var_2d 6991 ENDIF 6993 6992 CALL surface_restore_elements( & 6994 m_soil_v(0)%var_2d, & 6993 m_soil_v(0)%var_2d, & 6995 6994 tmp_walltype_v_2d2(0)%var_2d, & 6996 surf_lsm_v(0)%start_index, & 6995 surf_lsm_v(0)%start_index, & 6997 6996 start_index_on_file, & 6998 6997 end_index_on_file, & … … 7000 6999 nxlf, nxrf, nysf, nynf, & 7001 7000 nys_on_file, nyn_on_file, & 7002 nxl_on_file,nxr_on_file ) 7003 7004 CASE ( 'm_soil_v(1)' ) 7005 7006 IF ( k == 1 ) THEN 7001 nxl_on_file,nxr_on_file ) 7002 7003 CASE ( 'm_soil_v(1)' ) 7004 7005 IF ( k == 1 ) THEN 7007 7006 IF ( .NOT. ALLOCATED( m_soil_v(1)%var_2d ) ) & 7008 7007 ALLOCATE( m_soil_v(1)%var_2d(nzb_soil:nzt_soil+1, & 7009 1:surf_lsm_v(1)%ns) ) 7010 READ ( 13 ) tmp_walltype_v_2d2(1)%var_2d 7011 ENDIF 7008 1:surf_lsm_v(1)%ns) ) 7009 READ ( 13 ) tmp_walltype_v_2d2(1)%var_2d 7010 ENDIF 7012 7011 CALL surface_restore_elements( & 7013 m_soil_v(1)%var_2d, & 7012 m_soil_v(1)%var_2d, & 7014 7013 tmp_walltype_v_2d2(1)%var_2d, & 7015 surf_lsm_v(1)%start_index, & 7014 surf_lsm_v(1)%start_index, & 7016 7015 start_index_on_file, & 7017 7016 end_index_on_file, & … … 7019 7018 nxlf, nxrf, nysf, nynf, & 7020 7019 nys_on_file, nyn_on_file, & 7021 nxl_on_file,nxr_on_file ) 7022 7023 7024 CASE ( 'm_soil_v(2)' ) 7025 7026 IF ( k == 1 ) THEN 7020 nxl_on_file,nxr_on_file ) 7021 7022 7023 CASE ( 'm_soil_v(2)' ) 7024 7025 IF ( k == 1 ) THEN 7027 7026 IF ( .NOT. ALLOCATED( m_soil_v(2)%var_2d ) ) & 7028 7027 ALLOCATE( m_soil_v(2)%var_2d(nzb_soil:nzt_soil+1, & 7029 1:surf_lsm_v(2)%ns) ) 7030 READ ( 13 ) tmp_walltype_v_2d2(2)%var_2d 7031 ENDIF 7028 1:surf_lsm_v(2)%ns) ) 7029 READ ( 13 ) tmp_walltype_v_2d2(2)%var_2d 7030 ENDIF 7032 7031 CALL surface_restore_elements( & 7033 m_soil_v(2)%var_2d, & 7032 m_soil_v(2)%var_2d, & 7034 7033 tmp_walltype_v_2d2(2)%var_2d, & 7035 surf_lsm_v(2)%start_index, & 7034 surf_lsm_v(2)%start_index, & 7036 7035 start_index_on_file, & 7037 7036 end_index_on_file, & … … 7039 7038 nxlf, nxrf, nysf, nynf, & 7040 7039 nys_on_file, nyn_on_file, & 7041 nxl_on_file,nxr_on_file ) 7042 7043 7044 CASE ( 'm_soil_v(3)' ) 7045 7046 IF ( k == 1 ) THEN 7040 nxl_on_file,nxr_on_file ) 7041 7042 7043 CASE ( 'm_soil_v(3)' ) 7044 7045 IF ( k == 1 ) THEN 7047 7046 IF ( .NOT. ALLOCATED( m_soil_v(3)%var_2d ) ) & 7048 7047 ALLOCATE( m_soil_v(1)%var_2d(nzb_soil:nzt_soil+1, & 7049 1:surf_lsm_v(3)%ns) ) 7050 READ ( 13 ) tmp_walltype_v_2d2(3)%var_2d 7051 ENDIF 7048 1:surf_lsm_v(3)%ns) ) 7049 READ ( 13 ) tmp_walltype_v_2d2(3)%var_2d 7050 ENDIF 7052 7051 CALL surface_restore_elements( & 7053 m_soil_v(3)%var_2d, & 7052 m_soil_v(3)%var_2d, & 7054 7053 tmp_walltype_v_2d2(3)%var_2d, & 7055 surf_lsm_v(3)%start_index, & 7054 surf_lsm_v(3)%start_index, & 7056 7055 start_index_on_file, & 7057 7056 end_index_on_file, & … … 7059 7058 nxlf, nxrf, nysf, nynf, & 7060 7059 nys_on_file, nyn_on_file, & 7061 nxl_on_file,nxr_on_file ) 7062 7063 7064 CASE ( 'm_liq_h' ) 7065 7066 IF ( k == 1 ) THEN 7060 nxl_on_file,nxr_on_file ) 7061 7062 7063 CASE ( 'm_liq_h' ) 7064 7065 IF ( k == 1 ) THEN 7067 7066 IF ( .NOT. ALLOCATED( m_liq_h%var_1d ) ) & 7068 ALLOCATE( m_liq_h%var_1d(1:surf_lsm_h%ns) ) 7069 READ ( 13 ) tmp_walltype_h_1d%var_1d 7070 ENDIF 7067 ALLOCATE( m_liq_h%var_1d(1:surf_lsm_h%ns) ) 7068 READ ( 13 ) tmp_walltype_h_1d%var_1d 7069 ENDIF 7071 7070 CALL surface_restore_elements( & 7072 7071 m_liq_h%var_1d, & 7073 7072 tmp_walltype_h_1d%var_1d, & 7074 surf_lsm_h%start_index, & 7073 surf_lsm_h%start_index, & 7075 7074 start_index_on_file, & 7076 7075 end_index_on_file, & … … 7078 7077 nxlf, nxrf, nysf, nynf, & 7079 7078 nys_on_file, nyn_on_file, & 7080 nxl_on_file,nxr_on_file ) 7081 7082 7083 CASE ( 'm_liq_v(0)' ) 7084 7085 IF ( k == 1 ) THEN 7079 nxl_on_file,nxr_on_file ) 7080 7081 7082 CASE ( 'm_liq_v(0)' ) 7083 7084 IF ( k == 1 ) THEN 7086 7085 IF ( .NOT. ALLOCATED( m_liq_v(0)%var_1d ) ) & 7087 ALLOCATE( m_liq_v(0)%var_1d(1:surf_lsm_v(0)%ns) ) 7088 READ ( 13 ) tmp_walltype_v_1d(0)%var_1d 7089 ENDIF 7086 ALLOCATE( m_liq_v(0)%var_1d(1:surf_lsm_v(0)%ns) ) 7087 READ ( 13 ) tmp_walltype_v_1d(0)%var_1d 7088 ENDIF 7090 7089 CALL surface_restore_elements( & 7091 7090 m_liq_v(0)%var_1d, & 7092 7091 tmp_walltype_v_1d(0)%var_1d, & 7093 surf_lsm_v(0)%start_index, & 7092 surf_lsm_v(0)%start_index, & 7094 7093 start_index_on_file, & 7095 7094 end_index_on_file, & … … 7097 7096 nxlf, nxrf, nysf, nynf, & 7098 7097 nys_on_file, nyn_on_file, & 7099 nxl_on_file,nxr_on_file ) 7100 7101 7102 CASE ( 'm_liq_v(1)' ) 7103 7104 IF ( k == 1 ) THEN 7098 nxl_on_file,nxr_on_file ) 7099 7100 7101 CASE ( 'm_liq_v(1)' ) 7102 7103 IF ( k == 1 ) THEN 7105 7104 IF ( .NOT. ALLOCATED( m_liq_v(1)%var_1d ) ) & 7106 ALLOCATE( m_liq_v(1)%var_1d(1:surf_lsm_v(1)%ns) ) 7107 READ ( 13 ) tmp_walltype_v_1d(1)%var_1d 7108 ENDIF 7105 ALLOCATE( m_liq_v(1)%var_1d(1:surf_lsm_v(1)%ns) ) 7106 READ ( 13 ) tmp_walltype_v_1d(1)%var_1d 7107 ENDIF 7109 7108 CALL surface_restore_elements( & 7110 7109 m_liq_v(1)%var_1d, & 7111 7110 tmp_walltype_v_1d(1)%var_1d, & 7112 surf_lsm_v(1)%start_index, & 7111 surf_lsm_v(1)%start_index, & 7113 7112 start_index_on_file, & 7114 7113 end_index_on_file, & … … 7116 7115 nxlf, nxrf, nysf, nynf, & 7117 7116 nys_on_file, nyn_on_file, & 7118 nxl_on_file,nxr_on_file ) 7119 7120 7121 CASE ( 'm_liq_v(2)' ) 7122 7123 IF ( k == 1 ) THEN 7117 nxl_on_file,nxr_on_file ) 7118 7119 7120 CASE ( 'm_liq_v(2)' ) 7121 7122 IF ( k == 1 ) THEN 7124 7123 IF ( .NOT. ALLOCATED( m_liq_v(2)%var_1d ) ) & 7125 ALLOCATE( m_liq_v(2)%var_1d(1:surf_lsm_v(2)%ns) ) 7126 READ ( 13 ) tmp_walltype_v_1d(2)%var_1d 7127 ENDIF 7124 ALLOCATE( m_liq_v(2)%var_1d(1:surf_lsm_v(2)%ns) ) 7125 READ ( 13 ) tmp_walltype_v_1d(2)%var_1d 7126 ENDIF 7128 7127 CALL surface_restore_elements( & 7129 7128 m_liq_v(2)%var_1d, & 7130 7129 tmp_walltype_v_1d(2)%var_1d, & 7131 surf_lsm_v(2)%start_index, & 7130 surf_lsm_v(2)%start_index, & 7132 7131 start_index_on_file, & 7133 7132 end_index_on_file, & … … 7135 7134 nxlf, nxrf, nysf, nynf, & 7136 7135 nys_on_file, nyn_on_file, & 7137 nxl_on_file,nxr_on_file ) 7138 7139 CASE ( 'm_liq_v(3)' ) 7140 7141 IF ( k == 1 ) THEN 7136 nxl_on_file,nxr_on_file ) 7137 7138 CASE ( 'm_liq_v(3)' ) 7139 7140 IF ( k == 1 ) THEN 7142 7141 IF ( .NOT. ALLOCATED( m_liq_v(3)%var_1d ) ) & 7143 ALLOCATE( m_liq_v(3)%var_1d(1:surf_lsm_v(3)%ns) ) 7144 READ ( 13 ) tmp_walltype_v_1d(3)%var_1d 7145 ENDIF 7142 ALLOCATE( m_liq_v(3)%var_1d(1:surf_lsm_v(3)%ns) ) 7143 READ ( 13 ) tmp_walltype_v_1d(3)%var_1d 7144 ENDIF 7146 7145 CALL surface_restore_elements( & 7147 7146 m_liq_v(3)%var_1d, & 7148 7147 tmp_walltype_v_1d(3)%var_1d, & 7149 surf_lsm_v(3)%start_index, & 7148 surf_lsm_v(3)%start_index, & 7150 7149 start_index_on_file, & 7151 7150 end_index_on_file, & … … 7153 7152 nxlf, nxrf, nysf, nynf, & 7154 7153 nys_on_file, nyn_on_file, & 7155 nxl_on_file,nxr_on_file ) 7156 7157 7158 CASE ( 't_surface_h' ) 7159 7160 IF ( k == 1 ) THEN 7154 nxl_on_file,nxr_on_file ) 7155 7156 7157 CASE ( 't_surface_h' ) 7158 7159 IF ( k == 1 ) THEN 7161 7160 IF ( .NOT. ALLOCATED( t_surface_h%var_1d ) ) & 7162 ALLOCATE( t_surface_h%var_1d(1:surf_lsm_h%ns) ) 7163 READ ( 13 ) tmp_walltype_h_1d%var_1d 7164 ENDIF 7161 ALLOCATE( t_surface_h%var_1d(1:surf_lsm_h%ns) ) 7162 READ ( 13 ) tmp_walltype_h_1d%var_1d 7163 ENDIF 7165 7164 CALL surface_restore_elements( & 7166 7165 t_surface_h%var_1d, & 7167 7166 tmp_walltype_h_1d%var_1d, & 7168 surf_lsm_h%start_index, & 7167 surf_lsm_h%start_index, & 7169 7168 start_index_on_file, & 7170 7169 end_index_on_file, & … … 7172 7171 nxlf, nxrf, nysf, nynf, & 7173 7172 nys_on_file, nyn_on_file, & 7174 nxl_on_file,nxr_on_file ) 7175 7176 CASE ( 't_surface_v(0)' ) 7177 7178 IF ( k == 1 ) THEN 7173 nxl_on_file,nxr_on_file ) 7174 7175 CASE ( 't_surface_v(0)' ) 7176 7177 IF ( k == 1 ) THEN 7179 7178 IF ( .NOT. ALLOCATED( t_surface_v(0)%var_1d ) ) & 7180 ALLOCATE( t_surface_v(0)%var_1d(1:surf_lsm_v(0)%ns) ) 7181 READ ( 13 ) tmp_walltype_v_1d(0)%var_1d 7182 ENDIF 7179 ALLOCATE( t_surface_v(0)%var_1d(1:surf_lsm_v(0)%ns) ) 7180 READ ( 13 ) tmp_walltype_v_1d(0)%var_1d 7181 ENDIF 7183 7182 CALL surface_restore_elements( & 7184 7183 t_surface_v(0)%var_1d, & 7185 7184 tmp_walltype_v_1d(0)%var_1d, & 7186 surf_lsm_v(0)%start_index, & 7185 surf_lsm_v(0)%start_index, & 7187 7186 start_index_on_file, & 7188 7187 end_index_on_file, & … … 7190 7189 nxlf, nxrf, nysf, nynf, & 7191 7190 nys_on_file, nyn_on_file, & 7192 nxl_on_file,nxr_on_file ) 7193 7194 CASE ( 't_surface_v(1)' ) 7195 7196 IF ( k == 1 ) THEN 7191 nxl_on_file,nxr_on_file ) 7192 7193 CASE ( 't_surface_v(1)' ) 7194 7195 IF ( k == 1 ) THEN 7197 7196 IF ( .NOT. ALLOCATED( t_surface_v(1)%var_1d ) ) & 7198 ALLOCATE( t_surface_v(1)%var_1d(1:surf_lsm_v(1)%ns) ) 7199 READ ( 13 ) tmp_walltype_v_1d(1)%var_1d 7200 ENDIF 7197 ALLOCATE( t_surface_v(1)%var_1d(1:surf_lsm_v(1)%ns) ) 7198 READ ( 13 ) tmp_walltype_v_1d(1)%var_1d 7199 ENDIF 7201 7200 CALL surface_restore_elements( & 7202 7201 t_surface_v(1)%var_1d, & 7203 7202 tmp_walltype_v_1d(1)%var_1d, & 7204 surf_lsm_v(1)%start_index, & 7205 start_index_on_file, & 7206 end_index_on_file, & 7207 nxlc, nysc, & 7208 nxlf, nxrf, nysf, nynf, & 7209 nys_on_file, nyn_on_file, & 7210 nxl_on_file,nxr_on_file ) 7211 7212 CASE ( 't_surface_v(2)' ) 7213 7214 IF ( k == 1 ) THEN 7215 IF ( .NOT. ALLOCATED( t_surface_v(2)%var_1d ) ) & 7216 ALLOCATE( t_surface_v(2)%var_1d(1:surf_lsm_v(2)%ns) ) 7217 READ ( 13 ) tmp_walltype_v_1d(2)%var_1d 7218 ENDIF 7219 CALL surface_restore_elements( & 7220 t_surface_v(2)%var_1d, & 7221 tmp_walltype_v_1d(2)%var_1d, & 7222 surf_lsm_v(2)%start_index, & 7203 surf_lsm_v(1)%start_index, & 7223 7204 start_index_on_file, & 7224 7205 end_index_on_file, & … … 7226 7207 nxlf, nxrf, nysf, nynf, & 7227 7208 nys_on_file, nyn_on_file, & 7228 nxl_on_file,nxr_on_file ) 7229 7230 CASE ( 't_surface_v(3)' ) 7231 7232 IF ( k == 1 ) THEN 7209 nxl_on_file,nxr_on_file ) 7210 7211 CASE ( 't_surface_v(2)' ) 7212 7213 IF ( k == 1 ) THEN 7214 IF ( .NOT. ALLOCATED( t_surface_v(2)%var_1d ) ) & 7215 ALLOCATE( t_surface_v(2)%var_1d(1:surf_lsm_v(2)%ns) ) 7216 READ ( 13 ) tmp_walltype_v_1d(2)%var_1d 7217 ENDIF 7218 CALL surface_restore_elements( & 7219 t_surface_v(2)%var_1d, & 7220 tmp_walltype_v_1d(2)%var_1d, & 7221 surf_lsm_v(2)%start_index, & 7222 start_index_on_file, & 7223 end_index_on_file, & 7224 nxlc, nysc, & 7225 nxlf, nxrf, nysf, nynf, & 7226 nys_on_file, nyn_on_file, & 7227 nxl_on_file,nxr_on_file ) 7228 7229 CASE ( 't_surface_v(3)' ) 7230 7231 IF ( k == 1 ) THEN 7233 7232 IF ( .NOT. ALLOCATED( t_surface_v(3)%var_1d ) ) & 7234 ALLOCATE( t_surface_v(3)%var_1d(1:surf_lsm_v(3)%ns) ) 7235 READ ( 13 ) tmp_walltype_v_1d(3)%var_1d 7236 ENDIF 7233 ALLOCATE( t_surface_v(3)%var_1d(1:surf_lsm_v(3)%ns) ) 7234 READ ( 13 ) tmp_walltype_v_1d(3)%var_1d 7235 ENDIF 7237 7236 CALL surface_restore_elements( & 7238 7237 t_surface_v(3)%var_1d, & 7239 7238 tmp_walltype_v_1d(3)%var_1d, & 7240 surf_lsm_v(3)%start_index, & 7239 surf_lsm_v(3)%start_index, & 7241 7240 start_index_on_file, & 7242 7241 end_index_on_file, & … … 7272 7271 INTEGER(iwp) :: j !< running index 7273 7272 INTEGER(iwp) :: m !< running index 7274 7273 7275 7274 LOGICAL :: flag_exceed_z0 = .FALSE. !< dummy flag to indicate whether roughness length is too high 7276 7275 LOGICAL :: flag_exceed_z0h = .FALSE. !< dummy flag to indicate whether roughness length for scalars is too high … … 7283 7282 DO m = 1, surf_lsm_h%ns 7284 7283 7285 i = surf_lsm_h%i(m) 7284 i = surf_lsm_h%i(m) 7286 7285 j = surf_lsm_h%j(m) 7287 7286 7288 7287 IF ( surf_lsm_h%water_surface(m) ) THEN 7289 7288 7290 7289 ! 7291 !-- Disabled: FLake parameterization. Ideally, the Charnock 7290 !-- Disabled: FLake parameterization. Ideally, the Charnock 7292 7291 !-- coefficient should depend on the water depth and the fetch 7293 7292 !-- length 7294 7293 ! re_0 = z0(j,i) * us(j,i) / molecular_viscosity 7295 ! 7294 ! 7296 7295 ! z0(j,i) = MAX( 0.1_wp * molecular_viscosity / us(j,i), & 7297 7296 ! alpha_ch * us(j,i) / g ) … … 7337 7336 flag_exceed_z0h = .TRUE. 7338 7337 ENDIF 7339 7340 7338 7339 7341 7340 ENDIF 7342 7341 ENDDO … … 7363 7362 7364 7363 END SUBROUTINE calc_z0_water_surface 7365 7364 7366 7365 7367 7366 !------------------------------------------------------------------------------! 7368 7367 ! Description: 7369 7368 ! ------------ 7370 !> Vertical interpolation and extrapolation of 1D soil profile input from 7371 !> dynamic input file onto the numeric vertical soil grid. 7369 !> Vertical interpolation and extrapolation of 1D soil profile input from 7370 !> dynamic input file onto the numeric vertical soil grid. 7372 7371 !------------------------------------------------------------------------------! 7373 7372 SUBROUTINE interpolate_soil_profile( var, var_file, z_grid, z_file, & … … 7452 7451 7453 7452 END FUNCTION psi_h 7454 7453 7455 7454 END MODULE land_surface_model_mod
Note: See TracChangeset
for help on using the changeset viewer.
