Changeset 4559 for palm/trunk/SOURCE/surface_mod.f90
- Timestamp:
- Jun 11, 2020 8:51:48 AM (4 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/surface_mod.f90 (modified) (22 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/surface_mod.f90
r4535 r4559 1 1 !> @file surface_mod.f90 2 !------------------------------------------------------------------------------ !2 !--------------------------------------------------------------------------------------------------! 3 3 ! This file is part of the PALM model system. 4 4 ! 5 ! PALM is free software: you can redistribute it and/or modify it under the 6 ! terms of the GNU General Public License as published by the Free Software 7 ! Foundation, either version 3 of the License, or (at your option) any later 8 ! version. 9 ! 10 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY 11 ! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR 12 ! A PARTICULAR PURPOSE. See the GNU General Public License for more details. 13 ! 14 ! You should have received a copy of the GNU General Public License along with 15 ! PALM. If not, see <http://www.gnu.org/licenses/>. 5 ! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General 6 ! Public License as published by the Free Software Foundation, either version 3 of the License, or 7 ! (at your option) any later version. 8 ! 9 ! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the 10 ! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General 11 ! Public License for more details. 12 ! 13 ! You should have received a copy of the GNU General Public License along with PALM. If not, see 14 ! <http://www.gnu.org/licenses/>. 16 15 ! 17 16 ! Copyright 1997-2020 Leibniz Universitaet Hannover 18 ! 19 ! ------------------------------------------------------------------------------!17 !--------------------------------------------------------------------------------------------------! 18 ! 20 19 ! 21 20 ! Current revisions: 22 ! ----------------- -21 ! ----------------- 23 22 ! 24 23 ! … … 26 25 ! ----------------- 27 26 ! $Id$ 28 ! bugfix for restart data format query 29 ! 27 ! File re-formatted to follow the PALM coding standard 28 ! 29 ! 4535 2020-05-15 12:07:23Z raasch 30 ! Bugfix for restart data format query 31 ! 30 32 ! 4521 2020-05-06 11:39:49Z schwenkel 31 33 ! Rename variable 32 ! 34 ! 33 35 ! 4517 2020-05-03 14:29:30Z raasch 34 ! added restart with MPI-IO for reading local arrays35 ! 36 ! Added restart with MPI-IO for reading local arrays 37 ! 36 38 ! 4502 2020-04-17 16:14:16Z schwenkel 37 39 ! Implementation of ice microphysics 38 ! 40 ! 39 41 ! 4495 2020-04-13 20:11:20Z raasch 40 ! restart data handling with MPI-IO added41 ! 42 ! Restart data handling with MPI-IO added 43 ! 42 44 ! 4366 2020-01-09 08:12:43Z raasch 43 ! workaround implemented to avoid vectorization bug on NEC Aurora44 ! 45 ! Workaround implemented to avoid vectorization bug on NEC Aurora 46 ! 45 47 ! 4360 2020-01-07 11:25:50Z suehring 46 48 ! Fix also remaining message calls. 47 ! 49 ! 48 50 ! 4354 2019-12-19 16:10:18Z suehring 49 51 ! Bugfix in message call and specify error number 50 ! 52 ! 51 53 ! 4346 2019-12-18 11:55:56Z motisi 52 ! Introduction of wall_flags_total_0, which currently sets bits based on static 53 ! topographyinformation used in wall_flags_static_054 ! 54 ! Introduction of wall_flags_total_0, which currently sets bits based on static topography 55 ! information used in wall_flags_static_0 56 ! 55 57 ! 4331 2019-12-10 18:25:02Z suehring 56 58 ! -pt_2m - array is moved to diagnostic_output_quantities 57 ! 59 ! 58 60 ! 4329 2019-12-10 15:46:36Z motisi 59 61 ! Renamed wall_flags_0 to wall_flags_static_0 60 ! 62 ! 61 63 ! 4245 2019-09-30 08:40:37Z pavelkrc 62 64 ! Corrected "Former revisions" section 63 ! 65 ! 64 66 ! 4168 2019-08-16 13:50:17Z suehring 65 ! Remove functions get_topography_top_index. These are now replaced by 66 ! precalculated arrays becauseof too much CPU-time consumption67 ! 67 ! Remove functions get_topography_top_index. These are now replaced by precalculated arrays because 68 ! of too much CPU-time consumption 69 ! 68 70 ! 4159 2019-08-15 13:31:35Z suehring 69 71 ! Surface classification revised and adjusted to changes in init_grid 70 ! 72 ! 71 73 ! 4156 2019-08-14 09:18:14Z schwenkel 72 74 ! Bugfix in case of cloud microphysics morrison 73 ! 75 ! 74 76 ! 4150 2019-08-08 20:00:47Z suehring 75 77 ! Generic routine to initialize single surface properties added 76 ! 78 ! 77 79 ! 4104 2019-07-17 17:08:20Z suehring 78 ! Bugfix, initialization of index space for boundary data structure accidantly 79 ! run over ghostpoints, causing a segmentation fault.80 ! 80 ! Bugfix, initialization of index space for boundary data structure accidantly run over ghost 81 ! points, causing a segmentation fault. 82 ! 81 83 ! 3943 2019-05-02 09:50:41Z maronga 82 84 ! - Revise initialization of the boundary data structure 83 85 ! - Add new data structure to set boundary conditions at vertical walls 84 ! 86 ! 85 87 ! 3943 2019-05-02 09:50:41Z maronga 86 88 ! Removed qsws_eb as it is no longer needed. 87 ! 89 ! 88 90 ! 3933 2019-04-25 12:33:20Z kanani 89 91 ! Add (de)allocation of pt_2m, 90 ! bugfix: initialize pt_2m91 ! 92 ! Bugfix: initialize pt_2m 93 ! 92 94 ! 3833 2019-03-28 15:04:04Z forkel 93 ! added USE chem_gasphase_mod (chem_modules will not transport nvar and nspec anymore)94 ! 95 ! Added USE chem_gasphase_mod (chem_modules will not transport nvar and nspec anymore) 96 ! 95 97 ! 3772 2019-02-28 15:51:57Z suehring 96 ! small change in the todo's97 ! 98 ! Small change in the todo's 99 ! 98 100 ! 3767 2019-02-27 08:18:02Z raasch 99 ! unused variables removed from rrd-subroutine parameter list100 ! 101 ! Unused variables removed from rrd-subroutine parameter list 102 ! 101 103 ! 3761 2019-02-25 15:31:42Z raasch 102 ! OpenACC directives added to avoid compiler warnings about unused variables, 103 ! unused variableremoved104 ! 104 ! OpenACC directives added to avoid compiler warnings about unused variables, unused variable 105 ! removed 106 ! 105 107 ! 3745 2019-02-15 18:57:56Z suehring 106 108 ! +waste_heat 107 ! 109 ! 108 110 ! 3744 2019-02-15 18:38:58Z suehring 109 111 ! OpenACC port for SPEC 110 ! 112 ! 111 113 ! 2233 2017-05-30 18:08:54Z suehring 112 114 ! Initial revision … … 115 117 ! Description: 116 118 ! ------------ 117 !> Surface module defines derived data structures to treat surface- 118 !> bounded grid cells. Three different types of surfaces are defined: 119 !> default surfaces, natural surfaces, and urban surfaces. The module 120 !> encompasses the allocation and initialization of surface arrays, and handles 121 !> reading and writing restart data. 122 !> In addition, a further derived data structure is defined, in order to set 123 !> boundary conditions at surfaces. 124 !> @todo For the moment, downward-facing surfaces are only classified as 125 !> default type 126 !> @todo Clean up urban-surface variables (some of them are not used any more) 127 !> @todo Revise initialization of surface fluxes (especially for chemistry) 119 !> Surface module defines derived data structures to treat surface-bounded grid cells. Three 120 !> different types of surfaces are defined: default surfaces, natural surfaces, and urban surfaces. 121 !> The module encompasses the allocation and initialization of surface arrays, and handles reading 122 !> and writing restart data. In addition, a further derived data structure is defined, in order to 123 !> set boundary conditions at surfaces. 124 !> @todo For the moment, downward-facing surfaces are only classified as default type 125 !> @todo Clean up urban-surface variables (some of them are not used any more) 126 !> @todo Revise initialization of surface fluxes (especially for chemistry) 128 127 !> @todo Get rid-off deallocation routines in restarts 129 !------------------------------------------------------------------------------ !128 !--------------------------------------------------------------------------------------------------! 130 129 MODULE surface_mod 131 130 132 USE arrays_3d, & 133 ONLY: heatflux_input_conversion, momentumflux_input_conversion, & 134 rho_air, rho_air_zw, zu, zw, waterflux_input_conversion 135 136 USE chem_gasphase_mod, & 137 ONLY: nvar, spc_names 131 USE arrays_3d, & 132 ONLY: heatflux_input_conversion, & 133 momentumflux_input_conversion, & 134 rho_air, & 135 rho_air_zw, & 136 zu, & 137 zw, & 138 waterflux_input_conversion 139 140 USE chem_gasphase_mod, & 141 ONLY: nvar, & 142 spc_names 138 143 139 144 USE chem_modules … … 141 146 USE control_parameters 142 147 143 USE indices, & 144 ONLY: nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb, nzt, & 148 USE indices, & 149 ONLY: nxl, & 150 nxlg, & 151 nxr, & 152 nxrg, & 153 nys, & 154 nysg, & 155 nyn, & 156 nyng, & 157 nzb, & 158 nzt, & 145 159 wall_flags_total_0 146 160 147 USE grid_variables, & 148 ONLY: dx, dy 161 USE grid_variables, & 162 ONLY: dx, & 163 dy 149 164 150 165 USE kinds 151 166 152 USE model_1d_mod, & 153 ONLY: rif1d, us1d, usws1d, vsws1d 167 USE model_1d_mod, & 168 ONLY: rif1d, & 169 us1d, & 170 usws1d, & 171 vsws1d 154 172 155 173 USE restart_data_mpi_io_mod, & 156 ONLY: rd_mpi_io_surface_filetypes, rrd_mpi_io, rrd_mpi_io_global_array, & 157 rrd_mpi_io_surface, total_number_of_surface_values, wrd_mpi_io, & 158 wrd_mpi_io_global_array, wrd_mpi_io_surface 174 ONLY: rd_mpi_io_surface_filetypes, & 175 rrd_mpi_io, & 176 rrd_mpi_io_global_array, & 177 rrd_mpi_io_surface, & 178 total_number_of_surface_values, & 179 wrd_mpi_io, & 180 wrd_mpi_io_global_array, & 181 wrd_mpi_io_surface 159 182 160 183 IMPLICIT NONE 161 184 162 185 ! 163 !-- Data type used to identify grid-points where horizontal boundary conditions 164 !-- are applied 186 !-- Data type used to identify grid-points where horizontal boundary conditions are applied 165 187 TYPE bc_type 166 INTEGER(iwp) :: ioff!< offset value in x-direction, used to determine index of surface element167 INTEGER(iwp) :: joff!< offset value in y-direction, used to determine index of surface element168 INTEGER(iwp) :: koff!< offset value in z-direction, used to determine index of surface element169 INTEGER(iwp) :: ns!< number of surface elements on the PE170 171 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid172 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid173 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: k !< z-index linking to the PALM 3D-grid174 175 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< startindex within surface data type for given (j,i)176 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< endindex within surface data type for given (j,i)188 INTEGER(iwp) :: ioff !< offset value in x-direction, used to determine index of surface element 189 INTEGER(iwp) :: joff !< offset value in y-direction, used to determine index of surface element 190 INTEGER(iwp) :: koff !< offset value in z-direction, used to determine index of surface element 191 INTEGER(iwp) :: ns !< number of surface elements on the PE 192 193 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid 194 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid 195 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: k !< z-index linking to the PALM 3D-grid 196 197 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< end index within surface data type for given (j,i) 198 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< start index within surface data type for given (j,i) 177 199 178 200 END TYPE bc_type … … 181 203 TYPE surf_type 182 204 183 LOGICAL :: albedo_from_ascii = .FALSE. !< flag indicating that albedo for urban surfaces is input via ASCII format (just for a workaround) 184 185 INTEGER(iwp) :: ioff !< offset value in x-direction, used to determine index of surface element 186 INTEGER(iwp) :: joff !< offset value in y-direction, used to determine index of surface element 187 INTEGER(iwp) :: koff !< offset value in z-direction, used to determine index of surface element 188 INTEGER(iwp) :: ns !< number of surface elements on the PE 189 190 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid 191 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid 192 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: k !< z-index linking to the PALM 3D-grid 205 INTEGER(iwp) :: ioff !< offset value in x-direction, used to determine index of surface element 206 INTEGER(iwp) :: joff !< offset value in y-direction, used to determine index of surface element 207 INTEGER(iwp) :: koff !< offset value in z-direction, used to determine index of surface element 208 INTEGER(iwp) :: ns !< number of surface elements on the PE 209 210 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: i !< x-index linking to the PALM 3D-grid 211 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: j !< y-index linking to the PALM 3D-grid 212 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: k !< z-index linking to the PALM 3D-grid 193 213 194 214 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: facing !< Bit indicating surface orientation 195 215 196 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< Start index within surface data type for given (j,i) 197 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< End index within surface data type for given (j,i) 198 199 REAL(wp), DIMENSION(:), ALLOCATABLE :: z_mo !< surface-layer height 200 REAL(wp), DIMENSION(:), ALLOCATABLE :: uvw_abs !< absolute surface-parallel velocity 201 REAL(wp), DIMENSION(:), ALLOCATABLE :: us !< friction velocity 202 REAL(wp), DIMENSION(:), ALLOCATABLE :: ts !< scaling parameter temerature 203 REAL(wp), DIMENSION(:), ALLOCATABLE :: qs !< scaling parameter humidity 204 REAL(wp), DIMENSION(:), ALLOCATABLE :: ss !< scaling parameter passive scalar 205 REAL(wp), DIMENSION(:), ALLOCATABLE :: qcs !< scaling parameter qc 206 REAL(wp), DIMENSION(:), ALLOCATABLE :: ncs !< scaling parameter nc 207 REAL(wp), DIMENSION(:), ALLOCATABLE :: qis !< scaling parameter qi 208 REAL(wp), DIMENSION(:), ALLOCATABLE :: nis !< scaling parameter ni 209 REAL(wp), DIMENSION(:), ALLOCATABLE :: qrs !< scaling parameter qr 210 REAL(wp), DIMENSION(:), ALLOCATABLE :: nrs !< scaling parameter nr 211 212 REAL(wp), DIMENSION(:), ALLOCATABLE :: ol !< Obukhov length 213 REAL(wp), DIMENSION(:), ALLOCATABLE :: rib !< Richardson bulk number 214 215 REAL(wp), DIMENSION(:), ALLOCATABLE :: z0 !< roughness length for momentum 216 REAL(wp), DIMENSION(:), ALLOCATABLE :: z0h !< roughness length for heat 217 REAL(wp), DIMENSION(:), ALLOCATABLE :: z0q !< roughness length for humidity 218 219 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt1 !< potential temperature at first grid level 220 REAL(wp), DIMENSION(:), ALLOCATABLE :: qv1 !< mixing ratio at first grid level 221 REAL(wp), DIMENSION(:), ALLOCATABLE :: vpt1 !< virtual potential temperature at first grid level 222 223 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: css !< scaling parameter chemical species 216 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: start_index !< Start index within surface data type for given (j,i) 217 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: end_index !< End index within surface data type for given (j,i) 218 219 LOGICAL :: albedo_from_ascii = .FALSE. !< flag indicating that albedo for urban surfaces is input via ASCII format 220 !< (just for a workaround) 221 222 REAL(wp), DIMENSION(:), ALLOCATABLE :: z_mo !< surface-layer height 223 REAL(wp), DIMENSION(:), ALLOCATABLE :: uvw_abs !< absolute surface-parallel velocity 224 REAL(wp), DIMENSION(:), ALLOCATABLE :: us !< friction velocity 225 REAL(wp), DIMENSION(:), ALLOCATABLE :: ts !< scaling parameter temerature 226 REAL(wp), DIMENSION(:), ALLOCATABLE :: qs !< scaling parameter humidity 227 REAL(wp), DIMENSION(:), ALLOCATABLE :: ss !< scaling parameter passive scalar 228 REAL(wp), DIMENSION(:), ALLOCATABLE :: qcs !< scaling parameter qc 229 REAL(wp), DIMENSION(:), ALLOCATABLE :: ncs !< scaling parameter nc 230 REAL(wp), DIMENSION(:), ALLOCATABLE :: qis !< scaling parameter qi 231 REAL(wp), DIMENSION(:), ALLOCATABLE :: nis !< scaling parameter ni 232 REAL(wp), DIMENSION(:), ALLOCATABLE :: qrs !< scaling parameter qr 233 REAL(wp), DIMENSION(:), ALLOCATABLE :: nrs !< scaling parameter nr 234 235 REAL(wp), DIMENSION(:), ALLOCATABLE :: ol !< Obukhov length 236 REAL(wp), DIMENSION(:), ALLOCATABLE :: rib !< Richardson bulk number 237 238 REAL(wp), DIMENSION(:), ALLOCATABLE :: z0 !< roughness length for momentum 239 REAL(wp), DIMENSION(:), ALLOCATABLE :: z0h !< roughness length for heat 240 REAL(wp), DIMENSION(:), ALLOCATABLE :: z0q !< roughness length for humidity 241 242 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt1 !< potential temperature at first grid level 243 REAL(wp), DIMENSION(:), ALLOCATABLE :: qv1 !< mixing ratio at first grid level 244 REAL(wp), DIMENSION(:), ALLOCATABLE :: vpt1 !< virtual potential temperature at first grid level 245 246 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: css !< scaling parameter chemical species 224 247 ! 225 248 !-- Define arrays for surface fluxes 226 REAL(wp), DIMENSION(:), ALLOCATABLE :: usws 227 REAL(wp), DIMENSION(:), ALLOCATABLE :: vsws 228 229 REAL(wp), DIMENSION(:), ALLOCATABLE :: shf 230 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws 231 REAL(wp), DIMENSION(:), ALLOCATABLE :: ssws 232 REAL(wp), DIMENSION(:), ALLOCATABLE :: qcsws 233 REAL(wp), DIMENSION(:), ALLOCATABLE :: ncsws 234 REAL(wp), DIMENSION(:), ALLOCATABLE :: qisws 235 REAL(wp), DIMENSION(:), ALLOCATABLE :: nisws 236 REAL(wp), DIMENSION(:), ALLOCATABLE :: qrsws 237 REAL(wp), DIMENSION(:), ALLOCATABLE :: nrsws 238 REAL(wp), DIMENSION(:), ALLOCATABLE :: sasws 249 REAL(wp), DIMENSION(:), ALLOCATABLE :: usws !< vertical momentum flux for u-component at horizontal surfaces 250 REAL(wp), DIMENSION(:), ALLOCATABLE :: vsws !< vertical momentum flux for v-component at horizontal surfaces 251 252 REAL(wp), DIMENSION(:), ALLOCATABLE :: shf !< surface flux sensible heat 253 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws !< surface flux latent heat 254 REAL(wp), DIMENSION(:), ALLOCATABLE :: ssws !< surface flux passive scalar 255 REAL(wp), DIMENSION(:), ALLOCATABLE :: qcsws !< surface flux qc 256 REAL(wp), DIMENSION(:), ALLOCATABLE :: ncsws !< surface flux nc 257 REAL(wp), DIMENSION(:), ALLOCATABLE :: qisws !< surface flux qi 258 REAL(wp), DIMENSION(:), ALLOCATABLE :: nisws !< surface flux ni 259 REAL(wp), DIMENSION(:), ALLOCATABLE :: qrsws !< surface flux qr 260 REAL(wp), DIMENSION(:), ALLOCATABLE :: nrsws !< surface flux nr 261 REAL(wp), DIMENSION(:), ALLOCATABLE :: sasws !< surface flux salinity 239 262 !-- Added for SALSA: 240 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: answs 241 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: amsws 242 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gtsws 243 244 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: cssws 263 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: answs !< surface flux aerosol number: dim 1: flux, dim 2: bin 264 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: amsws !< surface flux aerosol mass: dim 1: flux, dim 2: bin 265 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gtsws !< surface flux gesous tracers: dim 1: flux, dim 2: gas 266 267 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: cssws !< surface flux chemical species 245 268 ! 246 269 !-- Required for horizontal walls in production_e 247 REAL(wp), DIMENSION(:), ALLOCATABLE :: u_0 !< virtual velocity component (see production_e_init for further explanation) 248 REAL(wp), DIMENSION(:), ALLOCATABLE :: v_0 !< virtual velocity component (see production_e_init for further explanation) 249 250 REAL(wp), DIMENSION(:), ALLOCATABLE :: mom_flux_uv !< momentum flux usvs and vsus at vertical surfaces (used in diffusion_u and diffusion_v) 251 REAL(wp), DIMENSION(:), ALLOCATABLE :: mom_flux_w !< momentum flux wsus and wsvs at vertical surfaces (used in diffusion_w) 252 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mom_flux_tke !< momentum flux usvs, vsus, wsus, wsvs at vertical surfaces at grid center (used in production_e) 270 REAL(wp), DIMENSION(:), ALLOCATABLE :: u_0 !< virtual velocity component (see production_e_init for further explanation) 271 REAL(wp), DIMENSION(:), ALLOCATABLE :: v_0 !< virtual velocity component (see production_e_init for further explanation) 272 273 REAL(wp), DIMENSION(:), ALLOCATABLE :: mom_flux_uv !< momentum flux usvs and vsus at vertical surfaces 274 !< (used in diffusion_u and diffusion_v) 275 REAL(wp), DIMENSION(:), ALLOCATABLE :: mom_flux_w !< momentum flux wsus and wsvs at vertical surfaces 276 !< (used in diffusion_w) 277 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: mom_flux_tke !< momentum flux usvs, vsus, wsus, wsvs at vertical surfaces at grid 278 !< center (used in production_e) 253 279 ! 254 280 !-- Variables required for LSM as well as for USM … … 264 290 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: water_type !< water type at surface element 265 291 266 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: albedo_type !< albedo type, for each fraction (wall,green,window or vegetation,pavement water) 267 268 LOGICAL, DIMENSION(:), ALLOCATABLE :: building_surface !< flag parameter indicating that the surface element is covered by buildings (no LSM actions, not implemented yet) 269 LOGICAL, DIMENSION(:), ALLOCATABLE :: building_covered !< flag indicating that buildings are on top of orography, only used for vertical surfaces in LSM 292 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: albedo_type !< albedo type, for each fraction 293 !< (wall,green,window or vegetation,pavement water) 294 295 LOGICAL, DIMENSION(:), ALLOCATABLE :: building_surface !< flag parameter indicating that the surface element is covered 296 !< by buildings (no LSM actions, not implemented yet) 297 LOGICAL, DIMENSION(:), ALLOCATABLE :: building_covered !< flag indicating that buildings are on top of orography, 298 !< only used for vertical surfaces in LSM 270 299 LOGICAL, DIMENSION(:), ALLOCATABLE :: pavement_surface !< flag parameter for pavements 271 300 LOGICAL, DIMENSION(:), ALLOCATABLE :: water_surface !< flag parameter for water surfaces 272 301 LOGICAL, DIMENSION(:), ALLOCATABLE :: vegetation_surface !< flag parameter for natural land surfaces 273 302 274 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: albedo !< broadband albedo for each surface fraction (LSM: vegetation, water, pavement; USM: wall, green, window) 275 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: emissivity !< emissivity of the surface, for each fraction (LSM: vegetation, water, pavement; USM: wall, green, window) 276 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: frac !< relative surface fraction (LSM: vegetation, water, pavement; USM: wall, green, window) 277 278 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aldif !< albedo for longwave diffusive radiation, solar angle of 60 degrees 279 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aldir !< albedo for longwave direct radiation, solar angle of 60 degrees 280 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: asdif !< albedo for shortwave diffusive radiation, solar angle of 60 degrees 281 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: asdir !< albedo for shortwave direct radiation, solar angle of 60 degrees 282 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_aldif !< albedo for longwave diffusive radiation, solar angle of 60 degrees 283 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_aldir !< albedo for longwave direct radiation, solar angle of 60 degrees 284 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_asdif !< albedo for shortwave diffusive radiation, solar angle of 60 degrees 285 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_asdir !< albedo for shortwave direct radiation, solar angle of 60 degrees 286 287 REAL(wp), DIMENSION(:), ALLOCATABLE :: q_surface !< skin-surface mixing ratio 288 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_surface !< skin-surface temperature 289 REAL(wp), DIMENSION(:), ALLOCATABLE :: vpt_surface !< skin-surface virtual temperature 290 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net !< net radiation 291 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net_l !< net radiation, used in USM 292 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h !< heat conductivity of soil/ wall (W/m/K) 293 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_green !< heat conductivity of green soil (W/m/K) 294 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_window !< heat conductivity of windows (W/m/K) 295 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_def !< default heat conductivity of soil (W/m/K) 296 297 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_in !< incoming longwave radiation 298 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_out !< emitted longwave radiation 299 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_dif !< incoming longwave radiation from sky 300 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_ref !< incoming longwave radiation from reflection 301 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_res !< resedual longwave radiation in surface after last reflection step 302 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_in !< incoming shortwave radiation 303 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_out !< emitted shortwave radiation 304 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_dir !< direct incoming shortwave radiation 305 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_dif !< diffuse incoming shortwave radiation 306 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_ref !< incoming shortwave radiation from reflection 307 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_res !< resedual shortwave radiation in surface after last reflection step 308 309 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_liq !< liquid water coverage (of vegetated area) 310 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_veg !< vegetation coverage 311 REAL(wp), DIMENSION(:), ALLOCATABLE :: f_sw_in !< fraction of absorbed shortwave radiation by the surface layer (not implemented yet) 312 REAL(wp), DIMENSION(:), ALLOCATABLE :: ghf !< ground heat flux 313 REAL(wp), DIMENSION(:), ALLOCATABLE :: g_d !< coefficient for dependence of r_canopy on water vapour pressure deficit 314 REAL(wp), DIMENSION(:), ALLOCATABLE :: lai !< leaf area index 315 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surface_u !< coupling between surface and soil (depends on vegetation type) (W/m2/K) 316 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surface_s !< coupling between surface and soil (depends on vegetation type) (W/m2/K) 317 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_liq !< surface flux of latent heat (liquid water portion) 318 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_soil !< surface flux of latent heat (soil portion) 319 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg !< surface flux of latent heat (vegetation portion) 320 321 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a !< aerodynamic resistance 322 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a_green !< aerodynamic resistance at green fraction 323 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a_window !< aerodynamic resistance at window fraction 324 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_canopy !< canopy resistance 325 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_soil !< soil resistance 326 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_soil_min !< minimum soil resistance 327 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_s !< total surface resistance (combination of r_soil and r_canopy) 328 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_canopy_min !< minimum canopy (stomatal) resistance 329 330 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_10cm !< near surface air potential temperature at distance 10 cm from the surface (K) 331 332 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: alpha_vg !< coef. of Van Genuchten 333 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_w !< hydraulic diffusivity of soil (?) 334 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gamma_w !< hydraulic conductivity of soil (W/m/K) 335 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gamma_w_sat !< hydraulic conductivity at saturation 336 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: l_vg !< coef. of Van Genuchten 337 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_fc !< soil moisture at field capacity (m3/m3) 338 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_res !< residual soil moisture 339 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_sat !< saturation soil moisture (m3/m3) 340 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_wilt !< soil moisture at permanent wilting point (m3/m3) 341 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: n_vg !< coef. Van Genuchten 342 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_total_def !< default volumetric heat capacity of the (soil) layer (J/m3/K) 343 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_total !< volumetric heat capacity of the actual soil matrix (J/m3/K) 344 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: root_fr !< root fraction within the soil layers 303 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: albedo !< broadband albedo for each surface fraction 304 !< (LSM: vegetation, water, pavement; USM: wall, green, window) 305 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: emissivity !< emissivity of the surface, for each fraction 306 !< (LSM: vegetation, water, pavement; USM: wall, green, window) 307 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: frac !< relative surface fraction 308 !< (LSM: vegetation, water, pavement; USM: wall, green, window) 309 310 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aldif !< albedo for longwave diffusive radiation, solar angle of 60 degrees 311 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aldir !< albedo for longwave direct radiation, solar angle of 60 degrees 312 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: asdif !< albedo for shortwave diffusive radiation, solar angle of 60 deg. 313 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: asdir !< albedo for shortwave direct radiation, solar angle of 60 degrees 314 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_aldif !< albedo for longwave diffusive radiation, solar angle of 60 degrees 315 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_aldir !< albedo for longwave direct radiation, solar angle of 60 degrees 316 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_asdif !< albedo for shortwave diffusive radiation, solar angle of 60 deg. 317 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rrtm_asdir !< albedo for shortwave direct radiation, solar angle of 60 degrees 318 319 REAL(wp), DIMENSION(:), ALLOCATABLE :: q_surface !< skin-surface mixing ratio 320 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_surface !< skin-surface temperature 321 REAL(wp), DIMENSION(:), ALLOCATABLE :: vpt_surface !< skin-surface virtual temperature 322 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net !< net radiation 323 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net_l !< net radiation, used in USM 324 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h !< heat conductivity of soil/ wall (W/m/K) 325 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_green !< heat conductivity of green soil (W/m/K) 326 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_window !< heat conductivity of windows (W/m/K) 327 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_h_def !< default heat conductivity of soil (W/m/K) 328 329 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_in !< incoming longwave radiation 330 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_out !< emitted longwave radiation 331 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_dif !< incoming longwave radiation from sky 332 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_ref !< incoming longwave radiation from reflection 333 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_res !< resedual longwave radiation in surface after last reflection step 334 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_in !< incoming shortwave radiation 335 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_out !< emitted shortwave radiation 336 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_dir !< direct incoming shortwave radiation 337 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_dif !< diffuse incoming shortwave radiation 338 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_ref !< incoming shortwave radiation from reflection 339 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_sw_res !< resedual shortwave radiation in surface after last reflection step 340 341 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_liq !< liquid water coverage (of vegetated area) 342 REAL(wp), DIMENSION(:), ALLOCATABLE :: c_veg !< vegetation coverage 343 REAL(wp), DIMENSION(:), ALLOCATABLE :: f_sw_in !< fraction of absorbed shortwave radiation by the surface layer 344 !< (not implemented yet) 345 REAL(wp), DIMENSION(:), ALLOCATABLE :: ghf !< ground heat flux 346 REAL(wp), DIMENSION(:), ALLOCATABLE :: g_d !< coefficient for dependence of r_canopy 347 !< on water vapour pressure deficit 348 REAL(wp), DIMENSION(:), ALLOCATABLE :: lai !< leaf area index 349 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surface_u !< coupling between surface and soil (depends on vegetation type) 350 !< (W/m2/K) 351 REAL(wp), DIMENSION(:), ALLOCATABLE :: lambda_surface_s !< coupling between surface and soil (depends on vegetation type) 352 !< (W/m2/K) 353 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_liq !< surface flux of latent heat (liquid water portion) 354 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_soil !< surface flux of latent heat (soil portion) 355 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg !< surface flux of latent heat (vegetation portion) 356 357 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a !< aerodynamic resistance 358 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a_green !< aerodynamic resistance at green fraction 359 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_a_window !< aerodynamic resistance at window fraction 360 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_canopy !< canopy resistance 361 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_soil !< soil resistance 362 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_soil_min !< minimum soil resistance 363 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_s !< total surface resistance (combination of r_soil and r_canopy) 364 REAL(wp), DIMENSION(:), ALLOCATABLE :: r_canopy_min !< minimum canopy (stomatal) resistance 365 366 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_10cm !< near surface air potential temperature at distance 10 cm from 367 !< the surface (K) 368 369 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: alpha_vg !< coef. of Van Genuchten 370 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_w !< hydraulic diffusivity of soil (?) 371 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gamma_w !< hydraulic conductivity of soil (W/m/K) 372 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gamma_w_sat !< hydraulic conductivity at saturation 373 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: l_vg !< coef. of Van Genuchten 374 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_fc !< soil moisture at field capacity (m3/m3) 375 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_res !< residual soil moisture 376 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_sat !< saturation soil moisture (m3/m3) 377 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: m_wilt !< soil moisture at permanent wilting point (m3/m3) 378 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: n_vg !< coef. Van Genuchten 379 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_total_def !< default volumetric heat capacity of the (soil) layer (J/m3/K) 380 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_total !< volumetric heat capacity of the actual soil matrix (J/m3/K) 381 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: root_fr !< root fraction within the soil layers 345 382 346 383 !-- Indoor model variables 347 REAL(wp), DIMENSION(:), ALLOCATABLE :: waste_heat 384 REAL(wp), DIMENSION(:), ALLOCATABLE :: waste_heat !< waste heat 348 385 ! 349 386 !-- Urban surface variables 350 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: surface_types 351 352 LOGICAL, DIMENSION(:), ALLOCATABLE :: isroof_surf 353 LOGICAL, DIMENSION(:), ALLOCATABLE :: ground_level 387 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: surface_types !< array of types of wall parameters 388 389 LOGICAL, DIMENSION(:), ALLOCATABLE :: isroof_surf !< flag indicating roof surfaces 390 LOGICAL, DIMENSION(:), ALLOCATABLE :: ground_level !< flag indicating ground floor level surfaces 354 391 355 392 REAL(wp), DIMENSION(:), ALLOCATABLE :: target_temp_summer !< indoor target temperature summer … … 368 405 REAL(wp), DIMENSION(:), ALLOCATABLE :: transmissivity !< transmissivity of windows 369 406 370 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsl !< reflected shortwave radiation for local surface in i-th reflection 371 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutll !< reflected + emitted longwave radiation for local surface in i-th reflection 372 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf !< total radiation flux incoming to minus outgoing from local surface 373 374 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_wall_m !< surface temperature tendency (K) 375 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_window_m !< window surface temperature tendency (K) 376 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_green_m !< green surface temperature tendency (K) 377 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf !< kinematic wall heat flux of sensible heat (actually no longer needed) 378 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf_eb !< wall heat flux of sensible heat in wall normal direction 379 380 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb !< wall ground heat flux 381 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_window !< window ground heat flux 382 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_green !< green ground heat flux 383 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb !< indoor wall ground heat flux 384 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_window !< indoor window ground heat flux 385 386 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_out_change_0 387 388 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinsw !< shortwave radiation falling to local surface including radiation from reflections 389 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsw !< total shortwave radiation outgoing from nonvirtual surfaces surfaces after all reflection 390 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlw !< longwave radiation falling to local surface including radiation from reflections 391 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutlw !< total longwave radiation outgoing from nonvirtual surfaces surfaces after all reflection 392 393 REAL(wp), DIMENSION(:), ALLOCATABLE :: n_vg_green !< vangenuchten parameters 394 REAL(wp), DIMENSION(:), ALLOCATABLE :: alpha_vg_green !< vangenuchten parameters 395 REAL(wp), DIMENSION(:), ALLOCATABLE :: l_vg_green !< vangenuchten parameters 396 397 398 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_wall !< volumetric heat capacity of the material ( J m-3 K-1 ) (= 2.19E6) 399 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_wall !< wall grid spacing (center-center) 400 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_wall !< 1/dz_wall 401 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_wall_stag !< wall grid spacing (edge-edge) 402 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_wall_stag !< 1/dz_wall_stag 403 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_wall_m !< t_wall prognostic array 404 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw !< wall layer depths (m) 405 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_window !< volumetric heat capacity of the window material ( J m-3 K-1 ) (= 2.19E6) 406 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_window !< window grid spacing (center-center) 407 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_window !< 1/dz_window 408 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_window_stag !< window grid spacing (edge-edge) 409 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_window_stag !< 1/dz_window_stag 410 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_window_m !< t_window prognostic array 411 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw_window !< window layer depths (m) 412 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_green !< volumetric heat capacity of the green material ( J m-3 K-1 ) (= 2.19E6) 413 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_total_green !< volumetric heat capacity of the moist green material ( J m-3 K-1 ) (= 2.19E6) 414 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_green !< green grid spacing (center-center) 415 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_green !< 1/dz_green 416 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_green_stag !< green grid spacing (edge-edge) 417 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_green_stag !< 1/dz_green_stag 418 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_green_m !< t_green prognostic array 419 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw_green !< green layer depths (m) 420 421 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gamma_w_green_sat !< hydraulic conductivity 422 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_w_green 423 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gamma_w_green !< hydraulic conductivity 424 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tswc_h_m 425 426 427 !-- arrays for time averages 428 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net_av !< average of rad_net_l 429 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinsw_av !< average of sw radiation falling to local surface including radiation from reflections 430 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlw_av !< average of lw radiation falling to local surface including radiation from reflections 431 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswdir_av !< average of direct sw radiation falling to local surface 432 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswdif_av !< average of diffuse sw radiation from sky and model boundary falling to local surface 433 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlwdif_av !< average of diffuse lw radiation from sky and model boundary falling to local surface 434 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswref_av !< average of sw radiation falling to surface from reflections 435 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlwref_av !< average of lw radiation falling to surface from reflections 436 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsw_av !< average of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection 437 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutlw_av !< average of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection 438 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfins_av !< average of array of residua of sw radiation absorbed in surface after last reflection 439 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinl_av !< average of array of residua of lw radiation absorbed in surface after last reflection 440 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf_av !< average of total radiation flux incoming to minus outgoing from local surface 441 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_av !< average of wghf_eb 442 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_window_av !< average of wghf_eb window 443 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_green_av !< average of wghf_eb window 444 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_av !< indoor average of wghf_eb 445 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_window_av !< indoor average of wghf_eb window 446 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf_eb_av !< average of wshf_eb 447 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_av !< average of qsws 448 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg_av !< average of qsws_veg_eb 449 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_liq_av !< average of qsws_liq_eb 450 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_wall_av !< average of wall surface temperature (K) 451 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_av !< average of wall surface temperature (K) 452 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_window_av !< average of window surface temperature (K) 453 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_green_av !< average of green wall surface temperature (K) 454 455 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_10cm_av !< average of theta_10cm (K) 456 457 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_wall_av !< Average of t_wall 458 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_window_av !< Average of t_window 459 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_green_av !< Average of t_green 460 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: swc_av !< Average of swc 407 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsl !< reflected shortwave radiation for local surface in i-th reflection 408 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutll !< reflected + emitted longwave radiation for local surface 409 !< in i-th reflection 410 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf !< total radiation flux incoming to minus outgoing from local surface 411 412 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_wall_m !< surface temperature tendency (K) 413 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_window_m !< window surface temperature tendency (K) 414 REAL(wp), DIMENSION(:), ALLOCATABLE :: tt_surface_green_m !< green surface temperature tendency (K) 415 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf !< kinematic wall heat flux of sensible heat 416 !< (actually no longer needed) 417 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf_eb !< wall heat flux of sensible heat in wall normal direction 418 419 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb !< wall ground heat flux 420 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_window !< window ground heat flux 421 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_green !< green ground heat flux 422 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb !< indoor wall ground heat flux 423 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_window !< indoor window ground heat flux 424 425 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_lw_out_change_0 !< 426 427 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinsw !< shortwave radiation falling to local surface including radiation 428 !< from reflections 429 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsw !< total shortwave radiation outgoing from nonvirtual surfaces surfaces 430 !< after all reflection 431 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlw !< longwave radiation falling to local surface including radiation from 432 !< reflections 433 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutlw !< total longwave radiation outgoing from nonvirtual surfaces surfaces 434 !< after all reflection 435 436 REAL(wp), DIMENSION(:), ALLOCATABLE :: n_vg_green !< vangenuchten parameters 437 REAL(wp), DIMENSION(:), ALLOCATABLE :: alpha_vg_green !< vangenuchten parameters 438 REAL(wp), DIMENSION(:), ALLOCATABLE :: l_vg_green !< vangenuchten parameters 439 440 441 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_wall !< volumetric heat capacity of the material ( J m-3 K-1 ) 442 !< (= 2.19E6) 443 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_wall !< wall grid spacing (center-center) 444 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_wall !< 1/dz_wall 445 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_wall_stag !< wall grid spacing (edge-edge) 446 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_wall_stag !< 1/dz_wall_stag 447 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_wall_m !< t_wall prognostic array 448 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw !< wall layer depths (m) 449 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_window !< volumetric heat capacity of the window material ( J m-3 K-1 ) 450 !< (= 2.19E6) 451 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_window !< window grid spacing (center-center) 452 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_window !< 1/dz_window 453 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_window_stag !< window grid spacing (edge-edge) 454 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_window_stag !< 1/dz_window_stag 455 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_window_m !< t_window prognostic array 456 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw_window !< window layer depths (m) 457 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_green !< volumetric heat capacity of the green material ( J m-3 K-1 ) 458 !< (= 2.19E6) 459 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: rho_c_total_green !< volumetric heat capacity of the moist green material 460 !< ( J m-3 K-1 ) (= 2.19E6) 461 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_green !< green grid spacing (center-center) 462 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_green !< 1/dz_green 463 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: dz_green_stag !< green grid spacing (edge-edge) 464 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: ddz_green_stag !< 1/dz_green_stag 465 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tt_green_m !< t_green prognostic array 466 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zw_green !< green layer depths (m) 467 468 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gamma_w_green_sat !< hydraulic conductivity 469 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: lambda_w_green !< 470 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: gamma_w_green !< hydraulic conductivity 471 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tswc_h_m !< 472 473 474 !-- Arrays for time averages 475 REAL(wp), DIMENSION(:), ALLOCATABLE :: rad_net_av !< average of rad_net_l 476 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinsw_av !< average of sw radiation falling to local surface including 477 !< radiation from reflections 478 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlw_av !< average of lw radiation falling to local surface including 479 !< radiation from reflections 480 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswdir_av !< average of direct sw radiation falling to local surface 481 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswdif_av !< average of diffuse sw radiation from sky and model boundary 482 !< falling to local surface 483 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlwdif_av !< average of diffuse lw radiation from sky and model boundary 484 !< falling to local surface 485 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinswref_av !< average of sw radiation falling to surface from reflections 486 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinlwref_av !< average of lw radiation falling to surface from reflections 487 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutsw_av !< average of total sw radiation outgoing from nonvirtual 488 !< surfaces surfaces after all reflection 489 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfoutlw_av !< average of total lw radiation outgoing from nonvirtual 490 !< surfaces after all reflection 491 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfins_av !< average of array of residua of sw radiation absorbed in 492 !< surface after last reflection 493 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfinl_av !< average of array of residua of lw radiation absorbed in 494 !< surface after last reflection 495 REAL(wp), DIMENSION(:), ALLOCATABLE :: surfhf_av !< average of total radiation flux incoming to minus outgoing 496 !< from local surface 497 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_av !< average of wghf_eb 498 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_window_av !< average of wghf_eb window 499 REAL(wp), DIMENSION(:), ALLOCATABLE :: wghf_eb_green_av !< average of wghf_eb window 500 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_av !< indoor average of wghf_eb 501 REAL(wp), DIMENSION(:), ALLOCATABLE :: iwghf_eb_window_av !< indoor average of wghf_eb window 502 REAL(wp), DIMENSION(:), ALLOCATABLE :: wshf_eb_av !< average of wshf_eb 503 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_av !< average of qsws 504 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_veg_av !< average of qsws_veg_eb 505 REAL(wp), DIMENSION(:), ALLOCATABLE :: qsws_liq_av !< average of qsws_liq_eb 506 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_wall_av !< average of wall surface temperature (K) 507 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_av !< average of wall surface temperature (K) 508 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_window_av !< average of window surface temperature (K) 509 REAL(wp), DIMENSION(:), ALLOCATABLE :: t_surf_green_av !< average of green wall surface temperature (K) 510 511 REAL(wp), DIMENSION(:), ALLOCATABLE :: pt_10cm_av !< average of theta_10cm (K) 512 513 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_wall_av !< Average of t_wall 514 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_window_av !< Average of t_window 515 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: t_green_av !< Average of t_green 516 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: swc_av !< Average of swc 461 517 462 518 END TYPE surf_type 463 519 464 TYPE (bc_type), DIMENSION(0:1) :: bc_h!< boundary condition data type, horizontal upward- and downward facing surfaces465 TYPE (bc_type), DIMENSION(0:3) :: bc_v!< boundary condition data type, vertical surfaces520 TYPE (bc_type), DIMENSION(0:1) :: bc_h !< boundary condition data type, horizontal upward- and downward facing surfaces 521 TYPE (bc_type), DIMENSION(0:3) :: bc_v !< boundary condition data type, vertical surfaces 466 522 467 523 TYPE (surf_type), DIMENSION(0:2), TARGET :: surf_def_h !< horizontal default surfaces (Up, Down, and Top) … … 472 528 TYPE (surf_type), DIMENSION(0:3), TARGET :: surf_usm_v !< vertical urban surfaces (North, South, East, West) 473 529 474 INTEGER(iwp), PARAMETER :: ind_veg_wall = 0 !< index for vegetation / wall-surface fraction, used for access of albedo, emissivity, etc., for each surface type 475 INTEGER(iwp), PARAMETER :: ind_pav_green = 1 !< index for pavement / green-wall surface fraction, used for access of albedo, emissivity, etc., for each surface type 476 INTEGER(iwp), PARAMETER :: ind_wat_win = 2 !< index for water / window-surface fraction, used for access of albedo, emissivity, etc., for each surface type 477 478 INTEGER(iwp) :: ns_h_on_file(0:2) !< total number of horizontal surfaces with the same facing, required for writing restart data 479 INTEGER(iwp) :: ns_v_on_file(0:3) !< total number of vertical surfaces with the same facing, required for writing restart data 480 481 LOGICAL :: vertical_surfaces_exist = .FALSE. !< flag indicating that there are vertical urban/land surfaces 482 !< in the domain (required to activiate RTM) 483 484 LOGICAL :: surf_bulk_cloud_model = .FALSE. !< use cloud microphysics 485 LOGICAL :: surf_microphysics_morrison = .FALSE. !< use 2-moment Morrison (add. prog. eq. for nc and qc) 486 LOGICAL :: surf_microphysics_seifert = .FALSE. !< use 2-moment Seifert and Beheng scheme 487 LOGICAL :: surf_microphysics_ice_phase = .FALSE. !< use 2-moment Seifert and Beheng scheme 530 INTEGER(iwp), PARAMETER :: ind_veg_wall = 0 !< index for vegetation / wall-surface fraction, used for access of albedo, 531 !< emissivity, etc., for each surface type 532 INTEGER(iwp), PARAMETER :: ind_pav_green = 1 !< index for pavement / green-wall surface fraction, used for access of albedo, 533 !< emissivity, etc., for each surface type 534 INTEGER(iwp), PARAMETER :: ind_wat_win = 2 !< index for water / window-surface fraction, used for access of albedo, 535 !< emissivity, etc., for each surface type 536 537 INTEGER(iwp) :: ns_h_on_file(0:2) !< total number of horizontal surfaces with the same facing, required for writing 538 !< restart data 539 INTEGER(iwp) :: ns_v_on_file(0:3) !< total number of vertical surfaces with the same facing, required for writing restart data 540 541 LOGICAL :: vertical_surfaces_exist = .FALSE. !< flag indicating that there are vertical urban/land surfaces 542 !< in the domain (required to activiate RTM) 543 544 LOGICAL :: surf_bulk_cloud_model = .FALSE. !< use cloud microphysics 545 LOGICAL :: surf_microphysics_morrison = .FALSE. !< use 2-moment Morrison (add. prog. eq. for nc and qc) 546 LOGICAL :: surf_microphysics_seifert = .FALSE. !< use 2-moment Seifert and Beheng scheme 547 LOGICAL :: surf_microphysics_ice_phase = .FALSE. !< use 2-moment Seifert and Beheng scheme 488 548 489 549 … … 538 598 ! 539 599 !-- Public variables 540 PUBLIC bc_h, bc_v, ind_pav_green, ind_veg_wall, ind_wat_win, ns_h_on_file, ns_v_on_file, & 541 surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v, surf_type, & 542 vertical_surfaces_exist, surf_bulk_cloud_model, surf_microphysics_morrison, & 543 surf_microphysics_seifert, surf_microphysics_ice_phase 600 PUBLIC bc_h, & 601 bc_v, & 602 ind_pav_green, & 603 ind_veg_wall, & 604 ind_wat_win, & 605 ns_h_on_file, & 606 ns_v_on_file, & 607 surf_def_h, & 608 surf_def_v, & 609 surf_lsm_h, & 610 surf_lsm_v, & 611 surf_usm_h, & 612 surf_usm_v, & 613 surf_type, & 614 vertical_surfaces_exist, & 615 surf_bulk_cloud_model, & 616 surf_microphysics_morrison, & 617 surf_microphysics_seifert, & 618 surf_microphysics_ice_phase 544 619 ! 545 620 !-- Public subroutines and functions … … 560 635 CONTAINS 561 636 562 !------------------------------------------------------------------------------ !637 !--------------------------------------------------------------------------------------------------! 563 638 ! Description: 564 639 ! ------------ 565 !> Initialize data type for setting boundary conditions at horizontal and 566 !> vertical surfaces. 567 !------------------------------------------------------------------------------! 568 SUBROUTINE init_bc 569 570 IMPLICIT NONE 571 572 INTEGER(iwp) :: i !< loop index along x-direction 573 INTEGER(iwp) :: j !< loop index along y-direction 574 INTEGER(iwp) :: k !< loop index along y-direction 575 INTEGER(iwp) :: l !< running index for differently aligned surfaces 576 577 INTEGER(iwp), DIMENSION(0:1) :: num_h !< number of horizontal surfaces on subdomain 578 INTEGER(iwp), DIMENSION(0:1) :: num_h_kji !< number of horizontal surfaces at (j,i)-grid point 579 INTEGER(iwp), DIMENSION(0:1) :: start_index_h !< local start index of horizontal surface elements 580 581 INTEGER(iwp), DIMENSION(0:3) :: num_v !< number of vertical surfaces on subdomain 582 INTEGER(iwp), DIMENSION(0:3) :: num_v_kji !< number of vertical surfaces at (j,i)-grid point 583 INTEGER(iwp), DIMENSION(0:3) :: start_index_v !< local start index of vertical surface elements 584 ! 585 !-- Set offset indices, i.e. index difference between surface element and 586 !-- surface-bounded grid point. 587 !-- Horizontal surfaces - no horizontal offsets 588 bc_h(:)%ioff = 0 589 bc_h(:)%joff = 0 590 ! 591 !-- Horizontal surfaces, upward facing (0) and downward facing (1) 592 bc_h(0)%koff = -1 593 bc_h(1)%koff = 1 594 ! 595 !-- Vertical surfaces - no vertical offset 596 bc_v(0:3)%koff = 0 597 ! 598 !-- North- and southward facing - no offset in x 599 bc_v(0:1)%ioff = 0 600 ! 601 !-- Northward facing offset in y 602 bc_v(0)%joff = -1 603 ! 604 !-- Southward facing offset in y 605 bc_v(1)%joff = 1 606 ! 607 !-- East- and westward facing - no offset in y 608 bc_v(2:3)%joff = 0 609 ! 610 !-- Eastward facing offset in x 611 bc_v(2)%ioff = -1 612 ! 613 !-- Westward facing offset in y 614 bc_v(3)%ioff = 1 615 ! 616 !-- Initialize data structure for horizontal surfaces, i.e. count the number 617 !-- of surface elements, allocate and initialize the respective index arrays, 618 !-- and set the respective start and end indices at each (j,i)-location. 619 !-- The index space is defined also over the ghost points, so that e.g. 620 !-- boundary conditions for diagnostic quanitities can be set on ghost 621 !-- points so that no exchange is required any more. 622 DO l = 0, 1 623 ! 624 !-- Count the number of upward- and downward-facing surfaces on subdomain 625 num_h(l) = 0 626 DO i = nxlg, nxrg 627 DO j = nysg, nyng 628 DO k = nzb+1, nzt 629 ! 630 !-- Check if current gridpoint belongs to the atmosphere 631 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 632 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_h(l)%koff, & 633 j+bc_h(l)%joff, & 634 i+bc_h(l)%ioff), 0 ) ) & 635 num_h(l) = num_h(l) + 1 636 ENDIF 637 ENDDO 638 ENDDO 639 ENDDO 640 ! 641 !-- Save the number of horizontal surface elements 642 bc_h(l)%ns = num_h(l) 643 ! 644 !-- ALLOCATE arrays for horizontal surfaces 645 ALLOCATE( bc_h(l)%i(1:bc_h(l)%ns) ) 646 ALLOCATE( bc_h(l)%j(1:bc_h(l)%ns) ) 647 ALLOCATE( bc_h(l)%k(1:bc_h(l)%ns) ) 648 ALLOCATE( bc_h(l)%start_index(nysg:nyng,nxlg:nxrg) ) 649 ALLOCATE( bc_h(l)%end_index(nysg:nyng,nxlg:nxrg) ) 650 bc_h(l)%start_index = 1 651 bc_h(l)%end_index = 0 652 653 num_h(l) = 1 654 start_index_h(l) = 1 655 DO i = nxlg, nxrg 656 DO j = nysg, nyng 657 658 num_h_kji(l) = 0 659 DO k = nzb+1, nzt 660 ! 661 !-- Check if current gridpoint belongs to the atmosphere 662 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 663 ! 664 !-- Upward-facing 665 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_h(l)%koff, & 666 j+bc_h(l)%joff, & 667 i+bc_h(l)%ioff), 0 ) & 668 ) THEN 669 bc_h(l)%i(num_h(l)) = i 670 bc_h(l)%j(num_h(l)) = j 671 bc_h(l)%k(num_h(l)) = k 672 num_h_kji(l) = num_h_kji(l) + 1 673 num_h(l) = num_h(l) + 1 674 ENDIF 675 ENDIF 676 ENDDO 677 bc_h(l)%start_index(j,i) = start_index_h(l) 678 bc_h(l)%end_index(j,i) = bc_h(l)%start_index(j,i) + & 679 num_h_kji(l) - 1 680 start_index_h(l) = bc_h(l)%end_index(j,i) + 1 681 ENDDO 682 ENDDO 683 ENDDO 684 685 ! 686 !-- Initialize data structure for vertical surfaces, i.e. count the number 687 !-- of surface elements, allocate and initialize the respective index arrays, 688 !-- and set the respective start and end indices at each (j,i)-location. 689 DO l = 0, 3 690 ! 691 !-- Count the number of upward- and downward-facing surfaces on subdomain 692 num_v(l) = 0 693 DO i = nxl, nxr 694 DO j = nys, nyn 695 DO k = nzb+1, nzt 696 ! 697 !-- Check if current gridpoint belongs to the atmosphere 698 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 699 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_v(l)%koff, & 700 j+bc_v(l)%joff, & 701 i+bc_v(l)%ioff), 0 ) ) & 702 num_v(l) = num_v(l) + 1 703 ENDIF 704 ENDDO 705 ENDDO 706 ENDDO 707 ! 708 !-- Save the number of horizontal surface elements 709 bc_v(l)%ns = num_v(l) 710 ! 711 !-- ALLOCATE arrays for horizontal surfaces. In contrast to the 712 !-- horizontal surfaces, the index space is not defined over the 713 !-- ghost points. 714 ALLOCATE( bc_v(l)%i(1:bc_v(l)%ns) ) 715 ALLOCATE( bc_v(l)%j(1:bc_v(l)%ns) ) 716 ALLOCATE( bc_v(l)%k(1:bc_v(l)%ns) ) 717 ALLOCATE( bc_v(l)%start_index(nys:nyn,nxl:nxr) ) 718 ALLOCATE( bc_v(l)%end_index(nys:nyn,nxl:nxr) ) 719 bc_v(l)%start_index = 1 720 bc_v(l)%end_index = 0 721 722 num_v(l) = 1 723 start_index_v(l) = 1 724 DO i = nxl, nxr 725 DO j = nys, nyn 726 727 num_v_kji(l) = 0 728 DO k = nzb+1, nzt 729 ! 730 !-- Check if current gridpoint belongs to the atmosphere 731 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 732 ! 733 !-- Upward-facing 734 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_v(l)%koff, & 735 j+bc_v(l)%joff, & 736 i+bc_v(l)%ioff), 0 ) & 737 ) THEN 738 bc_v(l)%i(num_v(l)) = i 739 bc_v(l)%j(num_v(l)) = j 740 bc_v(l)%k(num_v(l)) = k 741 num_v_kji(l) = num_v_kji(l) + 1 742 num_v(l) = num_v(l) + 1 743 ENDIF 744 ENDIF 745 ENDDO 746 bc_v(l)%start_index(j,i) = start_index_v(l) 747 bc_v(l)%end_index(j,i) = bc_v(l)%start_index(j,i) + & 748 num_v_kji(l) - 1 749 start_index_v(l) = bc_v(l)%end_index(j,i) + 1 750 ENDDO 751 ENDDO 752 ENDDO 753 754 755 END SUBROUTINE init_bc 756 757 758 !------------------------------------------------------------------------------! 759 ! Description: 760 ! ------------ 761 !> Initialize horizontal and vertical surfaces. Counts the number of default-, 762 !> natural and urban surfaces and allocates memory, respectively. 763 !------------------------------------------------------------------------------! 764 SUBROUTINE init_surface_arrays 765 766 767 USE pegrid 768 769 770 IMPLICIT NONE 771 772 INTEGER(iwp) :: i !< running index x-direction 773 INTEGER(iwp) :: j !< running index y-direction 774 INTEGER(iwp) :: k !< running index z-direction 775 INTEGER(iwp) :: l !< index variable for surface facing 776 INTEGER(iwp) :: num_lsm_h !< number of horizontally-aligned natural surfaces 777 INTEGER(iwp) :: num_usm_h !< number of horizontally-aligned urban surfaces 778 779 INTEGER(iwp), DIMENSION(0:2) :: num_def_h !< number of horizontally-aligned default surfaces 780 INTEGER(iwp), DIMENSION(0:3) :: num_def_v !< number of vertically-aligned default surfaces 781 INTEGER(iwp), DIMENSION(0:3) :: num_lsm_v !< number of vertically-aligned natural surfaces 782 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v !< number of vertically-aligned urban surfaces 783 784 INTEGER(iwp) :: num_surf_v_l !< number of vertically-aligned local urban/land surfaces 785 INTEGER(iwp) :: num_surf_v !< number of vertically-aligned total urban/land surfaces 786 787 LOGICAL :: building !< flag indicating building grid point 788 LOGICAL :: terrain !< flag indicating natural terrain grid point 789 LOGICAL :: unresolved_building !< flag indicating a grid point where actually a building is 790 !< defined but not resolved by the vertical grid 791 792 num_def_h = 0 793 num_def_v = 0 794 num_lsm_h = 0 795 num_lsm_v = 0 796 num_usm_h = 0 797 num_usm_v = 0 798 ! 799 !-- Surfaces are classified according to the input data read from static 800 !-- input file. If no input file is present, all surfaces are classified 801 !-- either as natural, urban, or default, depending on the setting of 802 !-- land_surface and urban_surface. To control this, use the control 803 !-- flag topo_no_distinct 804 ! 805 !-- Count number of horizontal surfaces on local domain 806 DO i = nxl, nxr 807 DO j = nys, nyn 640 !> Initialize data type for setting boundary conditions at horizontal and vertical surfaces. 641 !--------------------------------------------------------------------------------------------------! 642 SUBROUTINE init_bc 643 644 IMPLICIT NONE 645 646 INTEGER(iwp) :: i !< loop index along x-direction 647 INTEGER(iwp) :: j !< loop index along y-direction 648 INTEGER(iwp) :: k !< loop index along y-direction 649 INTEGER(iwp) :: l !< running index for differently aligned surfaces 650 651 INTEGER(iwp), DIMENSION(0:1) :: num_h !< number of horizontal surfaces on subdomain 652 INTEGER(iwp), DIMENSION(0:1) :: num_h_kji !< number of horizontal surfaces at (j,i)-grid point 653 INTEGER(iwp), DIMENSION(0:1) :: start_index_h !< local start index of horizontal surface elements 654 655 INTEGER(iwp), DIMENSION(0:3) :: num_v !< number of vertical surfaces on subdomain 656 INTEGER(iwp), DIMENSION(0:3) :: num_v_kji !< number of vertical surfaces at (j,i)-grid point 657 INTEGER(iwp), DIMENSION(0:3) :: start_index_v !< local start index of vertical surface elements 658 ! 659 !-- Set offset indices, i.e. index difference between surface element and surface-bounded grid point. 660 !-- Horizontal surfaces - no horizontal offsets 661 bc_h(:)%ioff = 0 662 bc_h(:)%joff = 0 663 ! 664 !-- Horizontal surfaces, upward facing (0) and downward facing (1) 665 bc_h(0)%koff = -1 666 bc_h(1)%koff = 1 667 ! 668 !-- Vertical surfaces - no vertical offset 669 bc_v(0:3)%koff = 0 670 ! 671 !-- North- and southward facing - no offset in x 672 bc_v(0:1)%ioff = 0 673 ! 674 !-- Northward facing offset in y 675 bc_v(0)%joff = -1 676 ! 677 !-- Southward facing offset in y 678 bc_v(1)%joff = 1 679 ! 680 !-- East- and westward facing - no offset in y 681 bc_v(2:3)%joff = 0 682 ! 683 !-- Eastward facing offset in x 684 bc_v(2)%ioff = -1 685 ! 686 !-- Westward facing offset in y 687 bc_v(3)%ioff = 1 688 ! 689 !-- Initialize data structure for horizontal surfaces, i.e. count the number of surface elements, 690 !-- allocate and initialize the respective index arrays, and set the respective start and end 691 !-- indices at each (j,i)-location. The index space is defined also over the ghost points, so that 692 !-- e.g. boundary conditions for diagnostic quanitities can be set on ghost points so that no 693 !-- exchange is required any more. 694 DO l = 0, 1 695 ! 696 !-- Count the number of upward- and downward-facing surfaces on subdomain 697 num_h(l) = 0 698 DO i = nxlg, nxrg 699 DO j = nysg, nyng 808 700 DO k = nzb+1, nzt 809 701 ! 810 702 !-- Check if current gridpoint belongs to the atmosphere 811 703 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 812 ! 813 !-- Check if grid point adjoins to any upward-facing horizontal 814 !-- surface, e.g. the Earth surface, plane roofs, or ceilings. 815 816 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i), 0 ) ) THEN 817 ! 818 !-- Determine flags indicating a terrain surface, a building 819 !-- surface, 820 terrain = BTEST( wall_flags_total_0(k-1,j,i), 5 ) .OR. & 821 topo_no_distinct 822 building = BTEST( wall_flags_total_0(k-1,j,i), 6 ) .OR. & 823 topo_no_distinct 824 ! 825 !-- unresolved_building indicates a surface with equal height 826 !-- as terrain but with a non-grid resolved building on top. 827 !-- These surfaces will be flagged as urban surfaces. 828 unresolved_building = BTEST( wall_flags_total_0(k-1,j,i), 5 ) & 829 .AND. BTEST( wall_flags_total_0(k-1,j,i), 6 ) 830 ! 831 !-- Land-surface type 832 IF ( land_surface .AND. terrain .AND. & 833 .NOT. unresolved_building ) THEN 834 num_lsm_h = num_lsm_h + 1 835 ! 836 !-- Urban surface tpye 837 ELSEIF ( urban_surface .AND. building ) THEN 838 num_usm_h = num_usm_h + 1 839 ! 840 !-- Default-surface type 841 ELSEIF ( .NOT. land_surface .AND. & 842 .NOT. urban_surface ) THEN 843 844 num_def_h(0) = num_def_h(0) + 1 845 ! 846 !-- Unclassifified surface-grid point. Give error message. 847 ELSE 848 WRITE( message_string, * ) & 849 'Unclassified upward-facing ' // & 850 'surface element at '// & 851 'grid point (k,j,i) = ', k, j, i 852 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 853 ENDIF 854 855 ENDIF 856 ! 857 !-- Check for top-fluxes 858 IF ( k == nzt .AND. use_top_fluxes ) THEN 859 num_def_h(2) = num_def_h(2) + 1 860 ! 861 !-- Check for any other downward-facing surface. So far only for 862 !-- default surface type. 863 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i), 0 ) ) THEN 864 num_def_h(1) = num_def_h(1) + 1 865 ENDIF 866 704 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_h(l)%koff, j+bc_h(l)%joff, & 705 i+bc_h(l)%ioff), 0 ) ) num_h(l) = num_h(l) + 1 867 706 ENDIF 868 707 ENDDO … … 870 709 ENDDO 871 710 ! 872 !-- Count number of vertical surfaces on local domain 711 !-- Save the number of horizontal surface elements 712 bc_h(l)%ns = num_h(l) 713 ! 714 !-- ALLOCATE arrays for horizontal surfaces 715 ALLOCATE( bc_h(l)%i(1:bc_h(l)%ns) ) 716 ALLOCATE( bc_h(l)%j(1:bc_h(l)%ns) ) 717 ALLOCATE( bc_h(l)%k(1:bc_h(l)%ns) ) 718 ALLOCATE( bc_h(l)%start_index(nysg:nyng,nxlg:nxrg) ) 719 ALLOCATE( bc_h(l)%end_index(nysg:nyng,nxlg:nxrg) ) 720 bc_h(l)%start_index = 1 721 bc_h(l)%end_index = 0 722 723 num_h(l) = 1 724 start_index_h(l) = 1 725 DO i = nxlg, nxrg 726 DO j = nysg, nyng 727 728 num_h_kji(l) = 0 729 DO k = nzb+1, nzt 730 ! 731 !-- Check if current gridpoint belongs to the atmosphere 732 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 733 ! 734 !-- Upward-facing 735 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_h(l)%koff, j+bc_h(l)%joff, & 736 i+bc_h(l)%ioff), 0 ) ) THEN 737 bc_h(l)%i(num_h(l)) = i 738 bc_h(l)%j(num_h(l)) = j 739 bc_h(l)%k(num_h(l)) = k 740 num_h_kji(l) = num_h_kji(l) + 1 741 num_h(l) = num_h(l) + 1 742 ENDIF 743 ENDIF 744 ENDDO 745 bc_h(l)%start_index(j,i) = start_index_h(l) 746 bc_h(l)%end_index(j,i) = bc_h(l)%start_index(j,i) + num_h_kji(l) - 1 747 start_index_h(l) = bc_h(l)%end_index(j,i) + 1 748 ENDDO 749 ENDDO 750 ENDDO 751 752 ! 753 !-- Initialize data structure for vertical surfaces, i.e. count the number of surface elements, 754 !-- allocate and initialize the respective index arrays, and set the respective start and end 755 !-- indices at each (j,i)-location. 756 DO l = 0, 3 757 ! 758 !-- Count the number of upward- and downward-facing surfaces on subdomain 759 num_v(l) = 0 873 760 DO i = nxl, nxr 874 761 DO j = nys, nyn 875 762 DO k = nzb+1, nzt 763 ! 764 !-- Check if current gridpoint belongs to the atmosphere 876 765 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 877 ! 878 !-- Northward-facing 879 IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 ) ) THEN 880 ! 881 !-- Determine flags indicating terrain or building 882 883 terrain = BTEST( wall_flags_total_0(k,j-1,i), 5 ) .OR. & 884 topo_no_distinct 885 building = BTEST( wall_flags_total_0(k,j-1,i), 6 ) .OR. & 886 topo_no_distinct 887 888 unresolved_building = BTEST( wall_flags_total_0(k,j-1,i), 5 ) & 889 .AND. BTEST( wall_flags_total_0(k,j-1,i), 6 ) 890 891 IF ( land_surface .AND. terrain .AND. & 892 .NOT. unresolved_building ) THEN 893 num_lsm_v(0) = num_lsm_v(0) + 1 894 ELSEIF ( urban_surface .AND. building ) THEN 895 num_usm_v(0) = num_usm_v(0) + 1 896 ! 897 !-- Default-surface type 898 ELSEIF ( .NOT. land_surface .AND. & 899 .NOT. urban_surface ) THEN 900 num_def_v(0) = num_def_v(0) + 1 901 ! 902 !-- Unclassifified surface-grid point. Give error message. 903 ELSE 904 WRITE( message_string, * ) & 905 'Unclassified northward-facing ' // & 906 'surface element at '// & 907 'grid point (k,j,i) = ', k, j, i 908 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 909 910 ENDIF 911 ENDIF 912 ! 913 !-- Southward-facing 914 IF ( .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) ) THEN 915 ! 916 !-- Determine flags indicating terrain or building 917 terrain = BTEST( wall_flags_total_0(k,j+1,i), 5 ) .OR. & 918 topo_no_distinct 919 building = BTEST( wall_flags_total_0(k,j+1,i), 6 ) .OR. & 920 topo_no_distinct 921 922 unresolved_building = BTEST( wall_flags_total_0(k,j+1,i), 5 ) & 923 .AND. BTEST( wall_flags_total_0(k,j+1,i), 6 ) 924 925 IF ( land_surface .AND. terrain .AND. & 926 .NOT. unresolved_building ) THEN 927 num_lsm_v(1) = num_lsm_v(1) + 1 928 ELSEIF ( urban_surface .AND. building ) THEN 929 num_usm_v(1) = num_usm_v(1) + 1 930 ! 931 !-- Default-surface type 932 ELSEIF ( .NOT. land_surface .AND. & 933 .NOT. urban_surface ) THEN 934 num_def_v(1) = num_def_v(1) + 1 935 ! 936 !-- Unclassifified surface-grid point. Give error message. 937 ELSE 938 WRITE( message_string, * ) & 939 'Unclassified southward-facing ' // & 940 'surface element at '// & 941 'grid point (k,j,i) = ', k, j, i 942 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 943 944 ENDIF 945 ENDIF 946 ! 947 !-- Eastward-facing 948 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 ) ) THEN 949 ! 950 !-- Determine flags indicating terrain or building 951 terrain = BTEST( wall_flags_total_0(k,j,i-1), 5 ) .OR. & 952 topo_no_distinct 953 building = BTEST( wall_flags_total_0(k,j,i-1), 6 ) .OR. & 954 topo_no_distinct 955 956 unresolved_building = BTEST( wall_flags_total_0(k,j,i-1), 5 ) & 957 .AND. BTEST( wall_flags_total_0(k,j,i-1), 6 ) 958 959 IF ( land_surface .AND. terrain .AND. & 960 .NOT. unresolved_building ) THEN 961 num_lsm_v(2) = num_lsm_v(2) + 1 962 ELSEIF ( urban_surface .AND. building ) THEN 963 num_usm_v(2) = num_usm_v(2) + 1 964 ! 965 !-- Default-surface type 966 ELSEIF ( .NOT. land_surface .AND. & 967 .NOT. urban_surface ) THEN 968 num_def_v(2) = num_def_v(2) + 1 969 ! 970 !-- Unclassifified surface-grid point. Give error message. 971 ELSE 972 WRITE( message_string, * ) & 973 'Unclassified eastward-facing ' // & 974 'surface element at '// & 975 'grid point (k,j,i) = ', k, j, i 976 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 977 978 ENDIF 979 ENDIF 980 ! 981 !-- Westward-facing 982 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) ) THEN 983 ! 984 !-- Determine flags indicating terrain or building 985 terrain = BTEST( wall_flags_total_0(k,j,i+1), 5 ) .OR. & 986 topo_no_distinct 987 building = BTEST( wall_flags_total_0(k,j,i+1), 6 ) .OR. & 988 topo_no_distinct 989 990 unresolved_building = BTEST( wall_flags_total_0(k,j,i+1), 5 ) & 991 .AND. BTEST( wall_flags_total_0(k,j,i+1), 6 ) 992 993 IF ( land_surface .AND. terrain .AND. & 994 .NOT. unresolved_building ) THEN 995 num_lsm_v(3) = num_lsm_v(3) + 1 996 ELSEIF ( urban_surface .AND. building ) THEN 997 num_usm_v(3) = num_usm_v(3) + 1 998 ! 999 !-- Default-surface type 1000 ELSEIF ( .NOT. land_surface .AND. & 1001 .NOT. urban_surface ) THEN 1002 num_def_v(3) = num_def_v(3) + 1 1003 ! 1004 !-- Unclassifified surface-grid point. Give error message. 1005 ELSE 1006 WRITE( message_string, * ) & 1007 'Unclassified westward-facing ' // & 1008 'surface element at '// & 1009 'grid point (k,j,i) = ', k, j, i 1010 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 1011 1012 ENDIF 1013 ENDIF 766 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_v(l)%koff, j+bc_v(l)%joff, & 767 i+bc_v(l)%ioff), 0 ) ) num_v(l) = num_v(l) + 1 1014 768 ENDIF 1015 769 ENDDO 1016 770 ENDDO 1017 771 ENDDO 1018 1019 ! 1020 !-- Store number of surfaces per core. 1021 !-- Horizontal surface, default type, upward facing 1022 surf_def_h(0)%ns = num_def_h(0) 1023 ! 1024 !-- Horizontal surface, default type, downward facing 1025 surf_def_h(1)%ns = num_def_h(1) 1026 ! 1027 !-- Horizontal surface, default type, top downward facing 1028 surf_def_h(2)%ns = num_def_h(2) 1029 ! 1030 !-- Horizontal surface, natural type, so far only upward-facing 1031 surf_lsm_h%ns = num_lsm_h 1032 ! 1033 !-- Horizontal surface, urban type, so far only upward-facing 1034 surf_usm_h%ns = num_usm_h 1035 ! 1036 !-- Vertical surface, default type, northward facing 1037 surf_def_v(0)%ns = num_def_v(0) 1038 ! 1039 !-- Vertical surface, default type, southward facing 1040 surf_def_v(1)%ns = num_def_v(1) 1041 ! 1042 !-- Vertical surface, default type, eastward facing 1043 surf_def_v(2)%ns = num_def_v(2) 1044 ! 1045 !-- Vertical surface, default type, westward facing 1046 surf_def_v(3)%ns = num_def_v(3) 1047 ! 1048 !-- Vertical surface, natural type, northward facing 1049 surf_lsm_v(0)%ns = num_lsm_v(0) 1050 ! 1051 !-- Vertical surface, natural type, southward facing 1052 surf_lsm_v(1)%ns = num_lsm_v(1) 1053 ! 1054 !-- Vertical surface, natural type, eastward facing 1055 surf_lsm_v(2)%ns = num_lsm_v(2) 1056 ! 1057 !-- Vertical surface, natural type, westward facing 1058 surf_lsm_v(3)%ns = num_lsm_v(3) 1059 ! 1060 !-- Vertical surface, urban type, northward facing 1061 surf_usm_v(0)%ns = num_usm_v(0) 1062 ! 1063 !-- Vertical surface, urban type, southward facing 1064 surf_usm_v(1)%ns = num_usm_v(1) 1065 ! 1066 !-- Vertical surface, urban type, eastward facing 1067 surf_usm_v(2)%ns = num_usm_v(2) 1068 ! 1069 !-- Vertical surface, urban type, westward facing 1070 surf_usm_v(3)%ns = num_usm_v(3) 1071 ! 1072 !-- Allocate required attributes for horizontal surfaces - default type. 1073 !-- Upward-facing (l=0) and downward-facing (l=1). 1074 DO l = 0, 1 1075 CALL allocate_surface_attributes_h ( surf_def_h(l), nys, nyn, nxl, nxr ) 772 ! 773 !-- Save the number of horizontal surface elements 774 bc_v(l)%ns = num_v(l) 775 ! 776 !-- ALLOCATE arrays for horizontal surfaces. In contrast to the horizontal surfaces, the index 777 !-- space is not defined over the ghost points. 778 ALLOCATE( bc_v(l)%i(1:bc_v(l)%ns) ) 779 ALLOCATE( bc_v(l)%j(1:bc_v(l)%ns) ) 780 ALLOCATE( bc_v(l)%k(1:bc_v(l)%ns) ) 781 ALLOCATE( bc_v(l)%start_index(nys:nyn,nxl:nxr) ) 782 ALLOCATE( bc_v(l)%end_index(nys:nyn,nxl:nxr) ) 783 bc_v(l)%start_index = 1 784 bc_v(l)%end_index = 0 785 786 num_v(l) = 1 787 start_index_v(l) = 1 788 DO i = nxl, nxr 789 DO j = nys, nyn 790 791 num_v_kji(l) = 0 792 DO k = nzb+1, nzt 793 ! 794 !-- Check if current gridpoint belongs to the atmosphere 795 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 796 ! 797 !-- Upward-facing 798 IF ( .NOT. BTEST( wall_flags_total_0(k+bc_v(l)%koff, j+bc_v(l)%joff, & 799 i+bc_v(l)%ioff), 0 ) ) THEN 800 bc_v(l)%i(num_v(l)) = i 801 bc_v(l)%j(num_v(l)) = j 802 bc_v(l)%k(num_v(l)) = k 803 num_v_kji(l) = num_v_kji(l) + 1 804 num_v(l) = num_v(l) + 1 805 ENDIF 806 ENDIF 807 ENDDO 808 bc_v(l)%start_index(j,i) = start_index_v(l) 809 bc_v(l)%end_index(j,i) = bc_v(l)%start_index(j,i) + num_v_kji(l) - 1 810 start_index_v(l) = bc_v(l)%end_index(j,i) + 1 811 ENDDO 1076 812 ENDDO 1077 ! 1078 !-- Allocate required attributes for model top 1079 CALL allocate_surface_attributes_h_top ( surf_def_h(2), nys, nyn, nxl, nxr ) 1080 ! 1081 !-- Allocate required attributes for horizontal surfaces - natural type. 1082 CALL allocate_surface_attributes_h ( surf_lsm_h, nys, nyn, nxl, nxr ) 1083 ! 1084 !-- Allocate required attributes for horizontal surfaces - urban type. 1085 CALL allocate_surface_attributes_h ( surf_usm_h, nys, nyn, nxl, nxr ) 1086 1087 ! 1088 !-- Allocate required attributes for vertical surfaces. 1089 !-- Northward-facing (l=0), southward-facing (l=1), eastward-facing (l=2) 1090 !-- and westward-facing (l=3). 1091 !-- Default type. 1092 DO l = 0, 3 1093 CALL allocate_surface_attributes_v ( surf_def_v(l), & 1094 nys, nyn, nxl, nxr ) 813 ENDDO 814 815 816 END SUBROUTINE init_bc 817 818 819 !--------------------------------------------------------------------------------------------------! 820 ! Description: 821 ! ------------ 822 !> Initialize horizontal and vertical surfaces. Counts the number of default-, natural and urban 823 !> surfaces and allocates memory, respectively. 824 !--------------------------------------------------------------------------------------------------! 825 SUBROUTINE init_surface_arrays 826 827 828 USE pegrid 829 830 831 IMPLICIT NONE 832 833 INTEGER(iwp) :: i !< running index x-direction 834 INTEGER(iwp) :: j !< running index y-direction 835 INTEGER(iwp) :: k !< running index z-direction 836 INTEGER(iwp) :: l !< index variable for surface facing 837 INTEGER(iwp) :: num_lsm_h !< number of horizontally-aligned natural surfaces 838 INTEGER(iwp) :: num_usm_h !< number of horizontally-aligned urban surfaces 839 840 INTEGER(iwp), DIMENSION(0:2) :: num_def_h !< number of horizontally-aligned default surfaces 841 INTEGER(iwp), DIMENSION(0:3) :: num_def_v !< number of vertically-aligned default surfaces 842 INTEGER(iwp), DIMENSION(0:3) :: num_lsm_v !< number of vertically-aligned natural surfaces 843 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v !< number of vertically-aligned urban surfaces 844 845 INTEGER(iwp) :: num_surf_v_l !< number of vertically-aligned local urban/land surfaces 846 INTEGER(iwp) :: num_surf_v !< number of vertically-aligned total urban/land surfaces 847 848 LOGICAL :: building !< flag indicating building grid point 849 LOGICAL :: terrain !< flag indicating natural terrain grid point 850 LOGICAL :: unresolved_building !< flag indicating a grid point where actually a building is 851 !< defined but not resolved by the vertical grid 852 853 num_def_h = 0 854 num_def_v = 0 855 num_lsm_h = 0 856 num_lsm_v = 0 857 num_usm_h = 0 858 num_usm_v = 0 859 ! 860 !-- Surfaces are classified according to the input data read from static input file. If no input 861 !-- file is present, all surfaces are classified either as natural, urban, or default, depending on 862 !-- the setting of land_surface and urban_surface. To control this, use the control flag 863 !-- topo_no_distinct 864 ! 865 !-- Count number of horizontal surfaces on local domain 866 DO i = nxl, nxr 867 DO j = nys, nyn 868 DO k = nzb+1, nzt 869 ! 870 !-- Check if current gridpoint belongs to the atmosphere 871 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 872 ! 873 !-- Check if grid point adjoins to any upward-facing horizontal surface, e.g. the Earth 874 !-- surface, plane roofs, or ceilings. 875 876 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i), 0 ) ) THEN 877 ! 878 !-- Determine flags indicating a terrain surface, a building surface, 879 terrain = BTEST( wall_flags_total_0(k-1,j,i), 5 ) .OR. topo_no_distinct 880 building = BTEST( wall_flags_total_0(k-1,j,i), 6 ) .OR. topo_no_distinct 881 ! 882 !-- Unresolved_building indicates a surface with equal height as terrain but with a 883 !-- non-grid resolved building on top. These surfaces will be flagged as urban 884 !-- surfaces. 885 unresolved_building = BTEST( wall_flags_total_0(k-1,j,i), 5 ) .AND. & 886 BTEST( wall_flags_total_0(k-1,j,i), 6 ) 887 ! 888 !-- Land-surface type 889 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 890 num_lsm_h = num_lsm_h + 1 891 ! 892 !-- Urban surface tpye 893 ELSEIF ( urban_surface .AND. building ) THEN 894 num_usm_h = num_usm_h + 1 895 ! 896 !-- Default-surface type 897 ELSEIF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 898 num_def_h(0) = num_def_h(0) + 1 899 ! 900 !-- Unclassifified surface-grid point. Give error message. 901 ELSE 902 WRITE( message_string, * ) 'Unclassified upward-facing surface element '// & 903 'at grid point (k,j,i) = ', k, j, i 904 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 905 ENDIF 906 907 ENDIF 908 ! 909 !-- Check for top-fluxes 910 IF ( k == nzt .AND. use_top_fluxes ) THEN 911 num_def_h(2) = num_def_h(2) + 1 912 ! 913 !-- Check for any other downward-facing surface. So far only for default surface type. 914 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i), 0 ) ) THEN 915 num_def_h(1) = num_def_h(1) + 1 916 ENDIF 917 918 ENDIF 919 ENDDO 1095 920 ENDDO 1096 ! 1097 !-- Natural type 1098 DO l = 0, 3 1099 CALL allocate_surface_attributes_v ( surf_lsm_v(l), & 1100 nys, nyn, nxl, nxr ) 921 ENDDO 922 ! 923 !-- Count number of vertical surfaces on local domain 924 DO i = nxl, nxr 925 DO j = nys, nyn 926 DO k = nzb+1, nzt 927 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 928 ! 929 !-- Northward-facing 930 IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 ) ) THEN 931 ! 932 !-- Determine flags indicating terrain or building 933 934 terrain = BTEST( wall_flags_total_0(k,j-1,i), 5 ) .OR. topo_no_distinct 935 building = BTEST( wall_flags_total_0(k,j-1,i), 6 ) .OR. topo_no_distinct 936 937 unresolved_building = BTEST( wall_flags_total_0(k,j-1,i), 5 ) .AND. & 938 BTEST( wall_flags_total_0(k,j-1,i), 6 ) 939 940 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 941 num_lsm_v(0) = num_lsm_v(0) + 1 942 ELSEIF ( urban_surface .AND. building ) THEN 943 num_usm_v(0) = num_usm_v(0) + 1 944 ! 945 !-- Default-surface type 946 ELSEIF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 947 num_def_v(0) = num_def_v(0) + 1 948 ! 949 !-- Unclassifified surface-grid point. Give error message. 950 ELSE 951 WRITE( message_string, * ) 'Unclassified northward-facing surface ' // & 952 'element at grid point (k,j,i) = ', k, j, i 953 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 954 955 ENDIF 956 ENDIF 957 ! 958 !-- Southward-facing 959 IF ( .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) ) THEN 960 ! 961 !-- Determine flags indicating terrain or building 962 terrain = BTEST( wall_flags_total_0(k,j+1,i), 5 ) .OR. topo_no_distinct 963 building = BTEST( wall_flags_total_0(k,j+1,i), 6 ) .OR. topo_no_distinct 964 965 unresolved_building = BTEST( wall_flags_total_0(k,j+1,i), 5 ) .AND. & 966 BTEST( wall_flags_total_0(k,j+1,i), 6 ) 967 968 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 969 num_lsm_v(1) = num_lsm_v(1) + 1 970 ELSEIF ( urban_surface .AND. building ) THEN 971 num_usm_v(1) = num_usm_v(1) + 1 972 ! 973 !-- Default-surface type 974 ELSEIF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 975 num_def_v(1) = num_def_v(1) + 1 976 ! 977 !-- Unclassifified surface-grid point. Give error message. 978 ELSE 979 WRITE( message_string, * ) 'Unclassified southward-facing surface ' // & 980 'element at grid point (k,j,i) = ', k, j, i 981 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 982 983 ENDIF 984 ENDIF 985 ! 986 !-- Eastward-facing 987 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 ) ) THEN 988 ! 989 !-- Determine flags indicating terrain or building 990 terrain = BTEST( wall_flags_total_0(k,j,i-1), 5 ) .OR. topo_no_distinct 991 building = BTEST( wall_flags_total_0(k,j,i-1), 6 ) .OR. topo_no_distinct 992 993 unresolved_building = BTEST( wall_flags_total_0(k,j,i-1), 5 ) .AND. & 994 BTEST( wall_flags_total_0(k,j,i-1), 6 ) 995 996 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 997 num_lsm_v(2) = num_lsm_v(2) + 1 998 ELSEIF ( urban_surface .AND. building ) THEN 999 num_usm_v(2) = num_usm_v(2) + 1 1000 ! 1001 !-- Default-surface type 1002 ELSEIF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 1003 num_def_v(2) = num_def_v(2) + 1 1004 ! 1005 !-- Unclassifified surface-grid point. Give error message. 1006 ELSE 1007 WRITE( message_string, * ) 'Unclassified eastward-facing surface ' // & 1008 'element at grid point (k,j,i) = ', k, j, i 1009 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 1010 1011 ENDIF 1012 ENDIF 1013 ! 1014 !-- Westward-facing 1015 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) ) THEN 1016 ! 1017 !-- Determine flags indicating terrain or building 1018 terrain = BTEST( wall_flags_total_0(k,j,i+1), 5 ) .OR. topo_no_distinct 1019 building = BTEST( wall_flags_total_0(k,j,i+1), 6 ) .OR. topo_no_distinct 1020 1021 unresolved_building = BTEST( wall_flags_total_0(k,j,i+1), 5 ) .AND. & 1022 BTEST( wall_flags_total_0(k,j,i+1), 6 ) 1023 1024 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 1025 num_lsm_v(3) = num_lsm_v(3) + 1 1026 ELSEIF ( urban_surface .AND. building ) THEN 1027 num_usm_v(3) = num_usm_v(3) + 1 1028 ! 1029 !-- Default-surface type 1030 ELSEIF ( .NOT. land_surface .AND. .NOT. urban_surface ) THEN 1031 num_def_v(3) = num_def_v(3) + 1 1032 ! 1033 !-- Unclassifified surface-grid point. Give error message. 1034 ELSE 1035 WRITE( message_string, * ) 'Unclassified westward-facing surface ' // & 1036 'element at grid point (k,j,i) = ', k, j, i 1037 CALL message( 'surface_mod', 'PA0698', 1, 2, myid, 6, 0 ) 1038 1039 ENDIF 1040 ENDIF 1041 ENDIF 1042 ENDDO 1101 1043 ENDDO 1102 ! 1103 !-- Urban type 1104 DO l = 0, 3 1105 CALL allocate_surface_attributes_v ( surf_usm_v(l), & 1106 nys, nyn, nxl, nxr ) 1107 ENDDO 1108 ! 1109 !-- Set the flag for the existence of vertical urban/land surfaces 1110 num_surf_v_l = 0 1111 DO l = 0, 3 1112 num_surf_v_l = num_surf_v_l + surf_usm_v(l)%ns + surf_lsm_v(l)%ns 1113 ENDDO 1044 ENDDO 1045 1046 ! 1047 !-- Store number of surfaces per core. 1048 !-- Horizontal surface, default type, upward facing 1049 surf_def_h(0)%ns = num_def_h(0) 1050 ! 1051 !-- Horizontal surface, default type, downward facing 1052 surf_def_h(1)%ns = num_def_h(1) 1053 ! 1054 !-- Horizontal surface, default type, top downward facing 1055 surf_def_h(2)%ns = num_def_h(2) 1056 ! 1057 !-- Horizontal surface, natural type, so far only upward-facing 1058 surf_lsm_h%ns = num_lsm_h 1059 ! 1060 !-- Horizontal surface, urban type, so far only upward-facing 1061 surf_usm_h%ns = num_usm_h 1062 ! 1063 !-- Vertical surface, default type, northward facing 1064 surf_def_v(0)%ns = num_def_v(0) 1065 ! 1066 !-- Vertical surface, default type, southward facing 1067 surf_def_v(1)%ns = num_def_v(1) 1068 ! 1069 !-- Vertical surface, default type, eastward facing 1070 surf_def_v(2)%ns = num_def_v(2) 1071 ! 1072 !-- Vertical surface, default type, westward facing 1073 surf_def_v(3)%ns = num_def_v(3) 1074 ! 1075 !-- Vertical surface, natural type, northward facing 1076 surf_lsm_v(0)%ns = num_lsm_v(0) 1077 ! 1078 !-- Vertical surface, natural type, southward facing 1079 surf_lsm_v(1)%ns = num_lsm_v(1) 1080 ! 1081 !-- Vertical surface, natural type, eastward facing 1082 surf_lsm_v(2)%ns = num_lsm_v(2) 1083 ! 1084 !-- Vertical surface, natural type, westward facing 1085 surf_lsm_v(3)%ns = num_lsm_v(3) 1086 ! 1087 !-- Vertical surface, urban type, northward facing 1088 surf_usm_v(0)%ns = num_usm_v(0) 1089 ! 1090 !-- Vertical surface, urban type, southward facing 1091 surf_usm_v(1)%ns = num_usm_v(1) 1092 ! 1093 !-- Vertical surface, urban type, eastward facing 1094 surf_usm_v(2)%ns = num_usm_v(2) 1095 ! 1096 !-- Vertical surface, urban type, westward facing 1097 surf_usm_v(3)%ns = num_usm_v(3) 1098 ! 1099 !-- Allocate required attributes for horizontal surfaces - default type. 1100 !-- Upward-facing (l=0) and downward-facing (l=1). 1101 DO l = 0, 1 1102 CALL allocate_surface_attributes_h ( surf_def_h(l), nys, nyn, nxl, nxr ) 1103 ENDDO 1104 ! 1105 !-- Allocate required attributes for model top 1106 CALL allocate_surface_attributes_h_top ( surf_def_h(2), nys, nyn, nxl, nxr ) 1107 ! 1108 !-- Allocate required attributes for horizontal surfaces - natural type. 1109 CALL allocate_surface_attributes_h ( surf_lsm_h, nys, nyn, nxl, nxr ) 1110 ! 1111 !-- Allocate required attributes for horizontal surfaces - urban type. 1112 CALL allocate_surface_attributes_h ( surf_usm_h, nys, nyn, nxl, nxr ) 1113 1114 ! 1115 !-- Allocate required attributes for vertical surfaces. 1116 !-- Northward-facing (l=0), southward-facing (l=1), eastward-facing (l=2) and westward-facing (l=3). 1117 !-- Default type. 1118 DO l = 0, 3 1119 CALL allocate_surface_attributes_v ( surf_def_v(l), nys, nyn, nxl, nxr ) 1120 ENDDO 1121 ! 1122 !-- Natural type 1123 DO l = 0, 3 1124 CALL allocate_surface_attributes_v ( surf_lsm_v(l), nys, nyn, nxl, nxr ) 1125 ENDDO 1126 ! 1127 !-- Urban type 1128 DO l = 0, 3 1129 CALL allocate_surface_attributes_v ( surf_usm_v(l), nys, nyn, nxl, nxr ) 1130 ENDDO 1131 ! 1132 !-- Set the flag for the existence of vertical urban/land surfaces 1133 num_surf_v_l = 0 1134 DO l = 0, 3 1135 num_surf_v_l = num_surf_v_l + surf_usm_v(l)%ns + surf_lsm_v(l)%ns 1136 ENDDO 1114 1137 1115 1138 #if defined( __parallel ) 1116 CALL MPI_ALLREDUCE( num_surf_v_l, num_surf_v, 1, MPI_INTEGER, & 1117 MPI_SUM, comm2d, ierr) 1139 CALL MPI_ALLREDUCE( num_surf_v_l, num_surf_v, 1, MPI_INTEGER, MPI_SUM, comm2d, ierr) 1118 1140 #else 1119 1141 num_surf_v = num_surf_v_l 1120 1142 #endif 1121 1122 1123 1124 1125 1126 1127 !------------------------------------------------------------------------------ !1143 IF ( num_surf_v > 0 ) vertical_surfaces_exist = .TRUE. 1144 1145 1146 END SUBROUTINE init_surface_arrays 1147 1148 1149 !--------------------------------------------------------------------------------------------------! 1128 1150 ! Description: 1129 1151 ! ------------ 1130 1152 !> Enter horizontal and vertical surfaces. 1131 !------------------------------------------------------------------------------ !1153 !--------------------------------------------------------------------------------------------------! 1132 1154 #if defined( _OPENACC ) 1133 SUBROUTINE enter_surface_arrays 1134 1135 IMPLICIT NONE 1136 1137 INTEGER(iwp) :: l !< 1138 1139 !$ACC ENTER DATA & 1140 !$ACC COPYIN(surf_def_h(0:2)) & 1141 !$ACC COPYIN(surf_def_v(0:3)) & 1142 !$ACC COPYIN(surf_lsm_h) & 1143 !$ACC COPYIN(surf_lsm_v(0:3)) & 1144 !$ACC COPYIN(surf_usm_h) & 1145 !$ACC COPYIN(surf_usm_v(0:3)) 1146 1147 ! Copy data in surf_def_h(0:2) 1148 DO l = 0, 1 1149 CALL enter_surface_attributes_h(surf_def_h(l)) 1150 ENDDO 1151 CALL enter_surface_attributes_h_top(surf_def_h(2)) 1152 ! Copy data in surf_def_v(0:3) 1153 DO l = 0, 3 1154 CALL enter_surface_attributes_v(surf_def_v(l)) 1155 ENDDO 1156 ! Copy data in surf_lsm_h 1157 CALL enter_surface_attributes_h(surf_lsm_h) 1158 ! Copy data in surf_lsm_v(0:3) 1159 DO l = 0, 3 1160 CALL enter_surface_attributes_v(surf_lsm_v(l)) 1161 ENDDO 1162 ! Copy data in surf_usm_h 1163 CALL enter_surface_attributes_h(surf_usm_h) 1164 ! Copy data in surf_usm_v(0:3) 1165 DO l = 0, 3 1166 CALL enter_surface_attributes_v(surf_usm_v(l)) 1167 ENDDO 1168 1169 END SUBROUTINE enter_surface_arrays 1155 SUBROUTINE enter_surface_arrays 1156 1157 IMPLICIT NONE 1158 1159 INTEGER(iwp) :: l !< 1160 1161 !$ACC ENTER DATA & 1162 !$ACC COPYIN(surf_def_h(0:2)) & 1163 !$ACC COPYIN(surf_def_v(0:3)) & 1164 !$ACC COPYIN(surf_lsm_h) & 1165 !$ACC COPYIN(surf_lsm_v(0:3)) & 1166 !$ACC COPYIN(surf_usm_h) & 1167 !$ACC COPYIN(surf_usm_v(0:3)) 1168 ! 1169 !-- Copy data in surf_def_h(0:2) 1170 DO l = 0, 1 1171 CALL enter_surface_attributes_h( surf_def_h(l) ) 1172 ENDDO 1173 CALL enter_surface_attributes_h_top( surf_def_h(2) ) 1174 ! 1175 !-- Copy data in surf_def_v(0:3) 1176 DO l = 0, 3 1177 CALL enter_surface_attributes_v( surf_def_v(l) ) 1178 ENDDO 1179 ! 1180 !-- Copy data in surf_lsm_h 1181 CALL enter_surface_attributes_h( surf_lsm_h ) 1182 ! 1183 !-- Copy data in surf_lsm_v(0:3) 1184 DO l = 0, 3 1185 CALL enter_surface_attributes_v( surf_lsm_v(l) ) 1186 ENDDO 1187 ! 1188 !-- Copy data in surf_usm_h 1189 CALL enter_surface_attributes_h( surf_usm_h ) 1190 ! 1191 !-- Copy data in surf_usm_v(0:3) 1192 DO l = 0, 3 1193 CALL enter_surface_attributes_v( surf_usm_v(l) ) 1194 ENDDO 1195 1196 END SUBROUTINE enter_surface_arrays 1170 1197 #endif 1171 1198 1172 !------------------------------------------------------------------------------ !1199 !--------------------------------------------------------------------------------------------------! 1173 1200 ! Description: 1174 1201 ! ------------ 1175 1202 !> Exit horizontal and vertical surfaces. 1176 !------------------------------------------------------------------------------ !1203 !--------------------------------------------------------------------------------------------------! 1177 1204 #if defined( _OPENACC ) 1178 SUBROUTINE exit_surface_arrays 1179 1180 IMPLICIT NONE 1181 1182 INTEGER(iwp) :: l !< 1183 1184 ! Delete data in surf_def_h(0:2) 1185 DO l = 0, 1 1186 CALL exit_surface_attributes_h(surf_def_h(l)) 1187 ENDDO 1188 CALL exit_surface_attributes_h(surf_def_h(2)) 1189 ! Delete data in surf_def_v(0:3) 1190 DO l = 0, 3 1191 CALL exit_surface_attributes_v(surf_def_v(l)) 1192 ENDDO 1193 ! Delete data in surf_lsm_h 1194 CALL exit_surface_attributes_h(surf_lsm_h) 1195 ! Delete data in surf_lsm_v(0:3) 1196 DO l = 0, 3 1197 CALL exit_surface_attributes_v(surf_lsm_v(l)) 1198 ENDDO 1199 ! Delete data in surf_usm_h 1200 CALL exit_surface_attributes_h(surf_usm_h) 1201 ! Delete data in surf_usm_v(0:3) 1202 DO l = 0, 3 1203 CALL exit_surface_attributes_v(surf_usm_v(l)) 1204 ENDDO 1205 1206 !$ACC EXIT DATA & 1207 !$ACC DELETE(surf_def_h(0:2)) & 1208 !$ACC DELETE(surf_def_v(0:3)) & 1209 !$ACC DELETE(surf_lsm_h) & 1210 !$ACC DELETE(surf_lsm_v(0:3)) & 1211 !$ACC DELETE(surf_usm_h) & 1212 !$ACC DELETE(surf_usm_v(0:3)) 1213 1214 END SUBROUTINE exit_surface_arrays 1205 SUBROUTINE exit_surface_arrays 1206 1207 IMPLICIT NONE 1208 1209 INTEGER(iwp) :: l !< 1210 ! 1211 !-- Delete data in surf_def_h(0:2) 1212 DO l = 0, 1 1213 CALL exit_surface_attributes_h( surf_def_h(l) ) 1214 ENDDO 1215 CALL exit_surface_attributes_h( surf_def_h(2) ) 1216 ! 1217 !-- Delete data in surf_def_v(0:3) 1218 DO l = 0, 3 1219 CALL exit_surface_attributes_v( surf_def_v(l) ) 1220 ENDDO 1221 ! 1222 !-- Delete data in surf_lsm_h 1223 CALL exit_surface_attributes_h( surf_lsm_h ) 1224 ! 1225 !-- Delete data in surf_lsm_v(0:3) 1226 DO l = 0, 3 1227 CALL exit_surface_attributes_v( surf_lsm_v(l) ) 1228 ENDDO 1229 ! 1230 !-- Delete data in surf_usm_h 1231 CALL exit_surface_attributes_h( surf_usm_h ) 1232 ! 1233 !-- Delete data in surf_usm_v(0:3) 1234 DO l = 0, 3 1235 CALL exit_surface_attributes_v( surf_usm_v(l) ) 1236 ENDDO 1237 1238 !$ACC EXIT DATA & 1239 !$ACC DELETE(surf_def_h(0:2)) & 1240 !$ACC DELETE(surf_def_v(0:3)) & 1241 !$ACC DELETE(surf_lsm_h) & 1242 !$ACC DELETE(surf_lsm_v(0:3)) & 1243 !$ACC DELETE(surf_usm_h) & 1244 !$ACC DELETE(surf_usm_v(0:3)) 1245 1246 END SUBROUTINE exit_surface_arrays 1215 1247 #endif 1216 1248 1217 !------------------------------------------------------------------------------ !1249 !--------------------------------------------------------------------------------------------------! 1218 1250 ! Description: 1219 1251 ! ------------ 1220 !> Deallocating memory for upward and downward-facing horizontal surface types, 1221 !> except for top fluxes. 1222 !------------------------------------------------------------------------------! 1223 SUBROUTINE deallocate_surface_attributes_h( surfaces ) 1224 1225 IMPLICIT NONE 1226 1227 1228 TYPE(surf_type) :: surfaces !< respective surface type 1229 1230 1231 DEALLOCATE ( surfaces%start_index ) 1232 DEALLOCATE ( surfaces%end_index ) 1233 ! 1234 !-- Indices to locate surface element 1235 DEALLOCATE ( surfaces%i ) 1236 DEALLOCATE ( surfaces%j ) 1237 DEALLOCATE ( surfaces%k ) 1238 ! 1239 !-- Surface-layer height 1240 DEALLOCATE ( surfaces%z_mo ) 1241 ! 1242 !-- Surface orientation 1243 DEALLOCATE ( surfaces%facing ) 1244 ! 1245 !-- Surface-parallel wind velocity 1246 DEALLOCATE ( surfaces%uvw_abs ) 1247 ! 1248 !-- Roughness 1249 DEALLOCATE ( surfaces%z0 ) 1250 DEALLOCATE ( surfaces%z0h ) 1251 DEALLOCATE ( surfaces%z0q ) 1252 ! 1253 !-- Friction velocity 1254 DEALLOCATE ( surfaces%us ) 1255 ! 1256 !-- Stability parameter 1257 DEALLOCATE ( surfaces%ol ) 1258 ! 1259 !-- Bulk Richardson number 1260 DEALLOCATE ( surfaces%rib ) 1261 ! 1262 !-- Vertical momentum fluxes of u and v 1263 DEALLOCATE ( surfaces%usws ) 1264 DEALLOCATE ( surfaces%vsws ) 1265 ! 1266 !-- Required in production_e 1267 IF ( .NOT. constant_diffusion ) THEN 1268 DEALLOCATE ( surfaces%u_0 ) 1269 DEALLOCATE ( surfaces%v_0 ) 1270 ENDIF 1271 ! 1272 !-- Characteristic temperature and surface flux of sensible heat 1273 DEALLOCATE ( surfaces%ts ) 1274 DEALLOCATE ( surfaces%shf ) 1275 ! 1276 !-- surface temperature 1277 DEALLOCATE ( surfaces%pt_surface ) 1278 ! 1279 !-- Characteristic humidity and surface flux of latent heat 1280 IF ( humidity ) THEN 1281 DEALLOCATE ( surfaces%qs ) 1282 DEALLOCATE ( surfaces%qsws ) 1283 DEALLOCATE ( surfaces%q_surface ) 1284 DEALLOCATE ( surfaces%vpt_surface ) 1285 ENDIF 1286 ! 1287 !-- Characteristic scalar and surface flux of scalar 1288 IF ( passive_scalar ) THEN 1289 DEALLOCATE ( surfaces%ss ) 1290 DEALLOCATE ( surfaces%ssws ) 1291 ENDIF 1292 ! 1293 !-- Scaling parameter (cs*) and surface flux of chemical species 1294 IF ( air_chemistry ) THEN 1295 DEALLOCATE ( surfaces%css ) 1296 DEALLOCATE ( surfaces%cssws ) 1297 ENDIF 1298 ! 1299 !-- Arrays for storing potential temperature and 1300 !-- mixing ratio at first grid level 1301 DEALLOCATE ( surfaces%pt1 ) 1302 DEALLOCATE ( surfaces%qv1 ) 1303 DEALLOCATE ( surfaces%vpt1 ) 1252 !> Deallocating memory for upward and downward-facing horizontal surface types, except for top 1253 !> fluxes. 1254 !--------------------------------------------------------------------------------------------------! 1255 SUBROUTINE deallocate_surface_attributes_h( surfaces ) 1256 1257 IMPLICIT NONE 1258 1259 1260 TYPE(surf_type) :: surfaces !< respective surface type 1261 1262 1263 DEALLOCATE ( surfaces%start_index ) 1264 DEALLOCATE ( surfaces%end_index ) 1265 ! 1266 !-- Indices to locate surface element 1267 DEALLOCATE ( surfaces%i ) 1268 DEALLOCATE ( surfaces%j ) 1269 DEALLOCATE ( surfaces%k ) 1270 ! 1271 !-- Surface-layer height 1272 DEALLOCATE ( surfaces%z_mo ) 1273 ! 1274 !-- Surface orientation 1275 DEALLOCATE ( surfaces%facing ) 1276 ! 1277 !-- Surface-parallel wind velocity 1278 DEALLOCATE ( surfaces%uvw_abs ) 1279 ! 1280 !-- Roughness 1281 DEALLOCATE ( surfaces%z0 ) 1282 DEALLOCATE ( surfaces%z0h ) 1283 DEALLOCATE ( surfaces%z0q ) 1284 ! 1285 !-- Friction velocity 1286 DEALLOCATE ( surfaces%us ) 1287 ! 1288 !-- Stability parameter 1289 DEALLOCATE ( surfaces%ol ) 1290 ! 1291 !-- Bulk Richardson number 1292 DEALLOCATE ( surfaces%rib ) 1293 ! 1294 !-- Vertical momentum fluxes of u and v 1295 DEALLOCATE ( surfaces%usws ) 1296 DEALLOCATE ( surfaces%vsws ) 1297 ! 1298 !-- Required in production_e 1299 IF ( .NOT. constant_diffusion ) THEN 1300 DEALLOCATE ( surfaces%u_0 ) 1301 DEALLOCATE ( surfaces%v_0 ) 1302 ENDIF 1303 ! 1304 !-- Characteristic temperature and surface flux of sensible heat 1305 DEALLOCATE ( surfaces%ts ) 1306 DEALLOCATE ( surfaces%shf ) 1307 ! 1308 !-- Surface temperature 1309 DEALLOCATE ( surfaces%pt_surface ) 1310 ! 1311 !-- Characteristic humidity and surface flux of latent heat 1312 IF ( humidity ) THEN 1313 DEALLOCATE ( surfaces%qs ) 1314 DEALLOCATE ( surfaces%qsws ) 1315 DEALLOCATE ( surfaces%q_surface ) 1316 DEALLOCATE ( surfaces%vpt_surface ) 1317 ENDIF 1318 ! 1319 !-- Characteristic scalar and surface flux of scalar 1320 IF ( passive_scalar ) THEN 1321 DEALLOCATE ( surfaces%ss ) 1322 DEALLOCATE ( surfaces%ssws ) 1323 ENDIF 1324 ! 1325 !-- Scaling parameter (cs*) and surface flux of chemical species 1326 IF ( air_chemistry ) THEN 1327 DEALLOCATE ( surfaces%css ) 1328 DEALLOCATE ( surfaces%cssws ) 1329 ENDIF 1330 ! 1331 !-- Arrays for storing potential temperature and mixing ratio at first grid level 1332 DEALLOCATE ( surfaces%pt1 ) 1333 DEALLOCATE ( surfaces%qv1 ) 1334 DEALLOCATE ( surfaces%vpt1 ) 1304 1335 1305 1336 ! 1306 1337 !-- 1307 1308 1309 1310 1311 1312 1338 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1339 DEALLOCATE ( surfaces%qcs ) 1340 DEALLOCATE ( surfaces%ncs ) 1341 DEALLOCATE ( surfaces%qcsws ) 1342 DEALLOCATE ( surfaces%ncsws ) 1343 ENDIF 1313 1344 ! 1314 1345 !-- 1315 1316 1317 1318 1319 1320 1346 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1347 DEALLOCATE ( surfaces%qrs ) 1348 DEALLOCATE ( surfaces%nrs ) 1349 DEALLOCATE ( surfaces%qrsws ) 1350 DEALLOCATE ( surfaces%nrsws ) 1351 ENDIF 1321 1352 ! 1322 1353 !-- 1323 1324 1325 1326 1327 1328 1329 ! 1330 !-- 1331 1332 1333 1334 1335 1336 !------------------------------------------------------------------------------ !1354 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 1355 DEALLOCATE ( surfaces%qis ) 1356 DEALLOCATE ( surfaces%nis ) 1357 DEALLOCATE ( surfaces%qisws ) 1358 DEALLOCATE ( surfaces%nisws ) 1359 ENDIF 1360 ! 1361 !-- Salinity surface flux 1362 IF ( ocean_mode ) DEALLOCATE ( surfaces%sasws ) 1363 1364 END SUBROUTINE deallocate_surface_attributes_h 1365 1366 1367 !--------------------------------------------------------------------------------------------------! 1337 1368 ! Description: 1338 1369 ! ------------ 1339 !> Allocating memory for upward and downward-facing horizontal surface types, 1340 !> except for top fluxes. 1341 !------------------------------------------------------------------------------! 1342 SUBROUTINE allocate_surface_attributes_h( surfaces, & 1343 nys_l, nyn_l, nxl_l, nxr_l ) 1344 1345 IMPLICIT NONE 1346 1347 INTEGER(iwp) :: nyn_l !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1348 INTEGER(iwp) :: nys_l !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1349 INTEGER(iwp) :: nxl_l !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1350 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1351 1352 TYPE(surf_type) :: surfaces !< respective surface type 1353 1354 ! 1355 !-- Allocate arrays for start and end index of horizontal surface type 1356 !-- for each (j,i)-grid point. This is required e.g. in diffion_x, which is 1357 !-- called for each (j,i). In order to find the location where the 1358 !-- respective flux is store within the surface-type, start- and end- 1359 !-- index are stored for each (j,i). For example, each (j,i) can have 1360 !-- several entries where fluxes for horizontal surfaces might be stored, 1361 !-- e.g. for overhanging structures where several upward-facing surfaces 1362 !-- might exist for given (j,i). 1363 !-- If no surface of respective type exist at current (j,i), set indicies 1364 !-- such that loop in diffusion routines will not be entered. 1365 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1366 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1367 surfaces%start_index = 0 1368 surfaces%end_index = -1 1369 ! 1370 !-- Indices to locate surface element 1371 ALLOCATE ( surfaces%i(1:surfaces%ns) ) 1372 ALLOCATE ( surfaces%j(1:surfaces%ns) ) 1373 ALLOCATE ( surfaces%k(1:surfaces%ns) ) 1374 ! 1375 !-- Surface-layer height 1376 ALLOCATE ( surfaces%z_mo(1:surfaces%ns) ) 1377 ! 1378 !-- Surface orientation 1379 ALLOCATE ( surfaces%facing(1:surfaces%ns) ) 1380 ! 1381 !-- Surface-parallel wind velocity 1382 ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) ) 1383 ! 1384 !-- Roughness 1385 ALLOCATE ( surfaces%z0(1:surfaces%ns) ) 1386 ALLOCATE ( surfaces%z0h(1:surfaces%ns) ) 1387 ALLOCATE ( surfaces%z0q(1:surfaces%ns) ) 1388 ! 1389 !-- Friction velocity 1390 ALLOCATE ( surfaces%us(1:surfaces%ns) ) 1391 ! 1392 !-- Stability parameter 1393 ALLOCATE ( surfaces%ol(1:surfaces%ns) ) 1394 ! 1395 !-- Bulk Richardson number 1396 ALLOCATE ( surfaces%rib(1:surfaces%ns) ) 1397 ! 1398 !-- Vertical momentum fluxes of u and v 1399 ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 1400 ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 1401 ! 1402 !-- Required in production_e 1403 IF ( .NOT. constant_diffusion ) THEN 1404 ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 1405 ALLOCATE ( surfaces%v_0(1:surfaces%ns) ) 1406 ENDIF 1407 ! 1408 !-- Characteristic temperature and surface flux of sensible heat 1409 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 1410 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1411 ! 1412 !-- Surface temperature 1413 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 1414 ! 1415 !-- Characteristic humidity, surface flux of latent heat, and surface virtual potential temperature 1416 IF ( humidity ) THEN 1417 ALLOCATE ( surfaces%qs(1:surfaces%ns) ) 1418 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1419 ALLOCATE ( surfaces%q_surface(1:surfaces%ns) ) 1420 ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) ) 1421 ENDIF 1422 1423 ! 1424 !-- Characteristic scalar and surface flux of scalar 1425 IF ( passive_scalar ) THEN 1426 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 1427 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1428 ENDIF 1429 ! 1430 !-- Scaling parameter (cs*) and surface flux of chemical species 1431 IF ( air_chemistry ) THEN 1432 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 1433 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1434 ENDIF 1435 ! 1436 !-- Arrays for storing potential temperature and 1437 !-- mixing ratio at first grid level 1438 ALLOCATE ( surfaces%pt1(1:surfaces%ns) ) 1439 ALLOCATE ( surfaces%qv1(1:surfaces%ns) ) 1440 ALLOCATE ( surfaces%vpt1(1:surfaces%ns) ) 1370 !> Allocating memory for upward and downward-facing horizontal surface types, except for top fluxes. 1371 !--------------------------------------------------------------------------------------------------! 1372 SUBROUTINE allocate_surface_attributes_h( surfaces, nys_l, nyn_l, nxl_l, nxr_l ) 1373 1374 IMPLICIT NONE 1375 1376 INTEGER(iwp) :: nyn_l !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1377 INTEGER(iwp) :: nys_l !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1378 INTEGER(iwp) :: nxl_l !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1379 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1380 1381 TYPE(surf_type) :: surfaces !< respective surface type 1382 1383 ! 1384 !-- Allocate arrays for start and end index of horizontal surface type for each (j,i)-grid point. 1385 !-- This is required e.g. in diffion_x, which is called for each (j,i). In order to find the 1386 !-- location where the respective flux is store within the surface-type, start- and end-index are 1387 !-- stored for each (j,i). For example, each (j,i) can have several entries where fluxes for 1388 !-- horizontal surfaces might be stored, e.g. for overhanging structures where several upward-facing 1389 !-- surfaces might exist for given (j,i). If no surface of respective type exist at current (j,i), 1390 !-- set indicies such that loop in diffusion routines will not be entered. 1391 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1392 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1393 surfaces%start_index = 0 1394 surfaces%end_index = -1 1395 ! 1396 !-- Indices to locate surface element 1397 ALLOCATE ( surfaces%i(1:surfaces%ns) ) 1398 ALLOCATE ( surfaces%j(1:surfaces%ns) ) 1399 ALLOCATE ( surfaces%k(1:surfaces%ns) ) 1400 ! 1401 !-- Surface-layer height 1402 ALLOCATE ( surfaces%z_mo(1:surfaces%ns) ) 1403 ! 1404 !-- Surface orientation 1405 ALLOCATE ( surfaces%facing(1:surfaces%ns) ) 1406 ! 1407 !-- Surface-parallel wind velocity 1408 ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) ) 1409 ! 1410 !-- Roughness 1411 ALLOCATE ( surfaces%z0(1:surfaces%ns) ) 1412 ALLOCATE ( surfaces%z0h(1:surfaces%ns) ) 1413 ALLOCATE ( surfaces%z0q(1:surfaces%ns) ) 1414 ! 1415 !-- Friction velocity 1416 ALLOCATE ( surfaces%us(1:surfaces%ns) ) 1417 ! 1418 !-- Stability parameter 1419 ALLOCATE ( surfaces%ol(1:surfaces%ns) ) 1420 ! 1421 !-- Bulk Richardson number 1422 ALLOCATE ( surfaces%rib(1:surfaces%ns) ) 1423 ! 1424 !-- Vertical momentum fluxes of u and v 1425 ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 1426 ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 1427 ! 1428 !-- Required in production_e 1429 IF ( .NOT. constant_diffusion ) THEN 1430 ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 1431 ALLOCATE ( surfaces%v_0(1:surfaces%ns) ) 1432 ENDIF 1433 ! 1434 !-- Characteristic temperature and surface flux of sensible heat 1435 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 1436 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1437 ! 1438 !-- Surface temperature 1439 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 1440 ! 1441 !-- Characteristic humidity, surface flux of latent heat, and surface virtual potential temperature 1442 IF ( humidity ) THEN 1443 ALLOCATE ( surfaces%qs(1:surfaces%ns) ) 1444 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1445 ALLOCATE ( surfaces%q_surface(1:surfaces%ns) ) 1446 ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) ) 1447 ENDIF 1448 1449 ! 1450 !-- Characteristic scalar and surface flux of scalar 1451 IF ( passive_scalar ) THEN 1452 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 1453 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1454 ENDIF 1455 ! 1456 !-- Scaling parameter (cs*) and surface flux of chemical species 1457 IF ( air_chemistry ) THEN 1458 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 1459 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1460 ENDIF 1461 ! 1462 !-- Arrays for storing potential temperature and mixing ratio at first grid level 1463 ALLOCATE ( surfaces%pt1(1:surfaces%ns) ) 1464 ALLOCATE ( surfaces%qv1(1:surfaces%ns) ) 1465 ALLOCATE ( surfaces%vpt1(1:surfaces%ns) ) 1441 1466 ! 1442 1467 !-- 1443 1444 ALLOCATE ( surfaces%qcs(1:surfaces%ns))1445 ALLOCATE ( surfaces%ncs(1:surfaces%ns))1446 1447 1448 1468 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1469 ALLOCATE ( surfaces%qcs(1:surfaces%ns) ) 1470 ALLOCATE ( surfaces%ncs(1:surfaces%ns) ) 1471 ALLOCATE ( surfaces%qcsws(1:surfaces%ns) ) 1472 ALLOCATE ( surfaces%ncsws(1:surfaces%ns) ) 1473 ENDIF 1449 1474 ! 1450 1475 !-- 1451 1452 ALLOCATE ( surfaces%qrs(1:surfaces%ns))1453 ALLOCATE ( surfaces%nrs(1:surfaces%ns))1454 1455 1456 1476 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1477 ALLOCATE ( surfaces%qrs(1:surfaces%ns) ) 1478 ALLOCATE ( surfaces%nrs(1:surfaces%ns) ) 1479 ALLOCATE ( surfaces%qrsws(1:surfaces%ns) ) 1480 ALLOCATE ( surfaces%nrsws(1:surfaces%ns) ) 1481 ENDIF 1457 1482 1458 1483 ! 1459 1484 !-- 1460 1461 ALLOCATE ( surfaces%qis(1:surfaces%ns))1462 ALLOCATE ( surfaces%nis(1:surfaces%ns))1463 1464 1465 1466 1467 ! 1468 !-- 1469 1470 1471 1472 1473 1474 !------------------------------------------------------------------------------ !1485 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 1486 ALLOCATE ( surfaces%qis(1:surfaces%ns) ) 1487 ALLOCATE ( surfaces%nis(1:surfaces%ns) ) 1488 ALLOCATE ( surfaces%qisws(1:surfaces%ns) ) 1489 ALLOCATE ( surfaces%nisws(1:surfaces%ns) ) 1490 ENDIF 1491 1492 ! 1493 !-- Salinity surface flux 1494 IF ( ocean_mode ) ALLOCATE ( surfaces%sasws(1:surfaces%ns) ) 1495 1496 END SUBROUTINE allocate_surface_attributes_h 1497 1498 1499 !--------------------------------------------------------------------------------------------------! 1475 1500 ! Description: 1476 1501 ! ------------ 1477 !> Exit memory for upward and downward-facing horizontal surface types, 1478 !> except for top fluxes. 1479 !------------------------------------------------------------------------------! 1502 !> Exit memory for upward and downward-facing horizontal surface types, except for top fluxes. 1503 !--------------------------------------------------------------------------------------------------! 1480 1504 #if defined( _OPENACC ) 1481 SUBROUTINE exit_surface_attributes_h( surfaces ) 1482 1483 IMPLICIT NONE 1484 1485 TYPE(surf_type) :: surfaces !< respective surface type 1486 1505 SUBROUTINE exit_surface_attributes_h( surfaces ) 1506 1507 IMPLICIT NONE 1508 1509 TYPE(surf_type) :: surfaces !< respective surface type 1510 1511 !$ACC EXIT DATA & 1512 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1513 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1514 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1515 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1516 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1517 !$ACC DELETE(surfaces%z_mo(1:surfaces%ns)) & 1518 !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) & 1519 !$ACC DELETE(surfaces%z0(1:surfaces%ns)) & 1520 !$ACC COPYOUT(surfaces%us(1:surfaces%ns)) & 1521 !$ACC COPYOUT(surfaces%ol(1:surfaces%ns)) & 1522 !$ACC DELETE(surfaces%rib(1:surfaces%ns)) & 1523 !$ACC COPYOUT(surfaces%usws(1:surfaces%ns)) & 1524 !$ACC COPYOUT(surfaces%vsws(1:surfaces%ns)) & 1525 !$ACC COPYOUT(surfaces%ts(1:surfaces%ns)) & 1526 !$ACC COPYOUT(surfaces%shf(1:surfaces%ns)) & 1527 !$ACC DELETE(surfaces%pt_surface(1:surfaces%ns)) & 1528 !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) & 1529 !$ACC DELETE(surfaces%qv1(1:surfaces%ns)) 1530 1531 IF ( .NOT. constant_diffusion ) THEN 1487 1532 !$ACC EXIT DATA & 1488 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1489 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1490 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1491 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1492 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1493 !$ACC DELETE(surfaces%z_mo(1:surfaces%ns)) & 1494 !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) & 1495 !$ACC DELETE(surfaces%z0(1:surfaces%ns)) & 1496 !$ACC COPYOUT(surfaces%us(1:surfaces%ns)) & 1497 !$ACC COPYOUT(surfaces%ol(1:surfaces%ns)) & 1498 !$ACC DELETE(surfaces%rib(1:surfaces%ns)) & 1499 !$ACC COPYOUT(surfaces%usws(1:surfaces%ns)) & 1500 !$ACC COPYOUT(surfaces%vsws(1:surfaces%ns)) & 1501 !$ACC COPYOUT(surfaces%ts(1:surfaces%ns)) & 1502 !$ACC COPYOUT(surfaces%shf(1:surfaces%ns)) & 1503 !$ACC DELETE(surfaces%pt_surface(1:surfaces%ns)) & 1504 !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) & 1505 !$ACC DELETE(surfaces%qv1(1:surfaces%ns)) 1506 1507 IF ( .NOT. constant_diffusion ) THEN 1508 !$ACC EXIT DATA & 1509 !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) & 1510 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1511 ENDIF 1512 1513 END SUBROUTINE exit_surface_attributes_h 1533 !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) & 1534 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1535 ENDIF 1536 1537 END SUBROUTINE exit_surface_attributes_h 1514 1538 #endif 1515 1539 1516 !------------------------------------------------------------------------------ !1540 !--------------------------------------------------------------------------------------------------! 1517 1541 ! Description: 1518 1542 ! ------------ 1519 !> Enter memory for upward and downward-facing horizontal surface types, 1520 !> except for top fluxes. 1521 !------------------------------------------------------------------------------! 1543 !> Enter memory for upward and downward-facing horizontal surface types, except for top fluxes. 1544 !--------------------------------------------------------------------------------------------------! 1522 1545 #if defined( _OPENACC ) 1523 SUBROUTINE enter_surface_attributes_h( surfaces ) 1524 1525 IMPLICIT NONE 1526 1527 TYPE(surf_type) :: surfaces !< respective surface type 1528 1546 SUBROUTINE enter_surface_attributes_h( surfaces ) 1547 1548 IMPLICIT NONE 1549 1550 TYPE(surf_type) :: surfaces !< respective surface type 1551 1552 !$ACC ENTER DATA & 1553 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1554 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1555 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1556 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1557 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1558 !$ACC COPYIN(surfaces%z_mo(1:surfaces%ns)) & 1559 !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) & 1560 !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) & 1561 !$ACC COPYIN(surfaces%us(1:surfaces%ns)) & 1562 !$ACC COPYIN(surfaces%ol(1:surfaces%ns)) & 1563 !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) & 1564 !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) & 1565 !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) & 1566 !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) & 1567 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) & 1568 !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) & 1569 !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) & 1570 !$ACC COPYIN(surfaces%pt_surface(1:surfaces%ns)) 1571 1572 IF ( .NOT. constant_diffusion ) THEN 1529 1573 !$ACC ENTER DATA & 1530 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1531 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1532 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1533 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1534 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1535 !$ACC COPYIN(surfaces%z_mo(1:surfaces%ns)) & 1536 !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) & 1537 !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) & 1538 !$ACC COPYIN(surfaces%us(1:surfaces%ns)) & 1539 !$ACC COPYIN(surfaces%ol(1:surfaces%ns)) & 1540 !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) & 1541 !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) & 1542 !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) & 1543 !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) & 1544 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) & 1545 !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) & 1546 !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) & 1547 !$ACC COPYIN(surfaces%pt_surface(1:surfaces%ns)) 1548 1549 IF ( .NOT. constant_diffusion ) THEN 1550 !$ACC ENTER DATA & 1551 !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) & 1552 !$ACC COPYIN(surfaces%v_0(1:surfaces%ns)) 1553 ENDIF 1554 1555 END SUBROUTINE enter_surface_attributes_h 1574 !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) & 1575 !$ACC COPYIN(surfaces%v_0(1:surfaces%ns)) 1576 ENDIF 1577 1578 END SUBROUTINE enter_surface_attributes_h 1556 1579 #endif 1557 1580 1558 !------------------------------------------------------------------------------ !1581 !--------------------------------------------------------------------------------------------------! 1559 1582 ! Description: 1560 1583 ! ------------ 1561 1584 !> Deallocating memory for model-top fluxes 1562 !------------------------------------------------------------------------------ !1563 1564 1565 1566 1567 1568 1569 1570 1571 1572 ! 1573 !-- 1574 1575 1576 1577 1578 1579 1580 1581 1582 ! 1583 !-- 1584 1585 1586 ! 1587 !-- 1588 1589 ! 1590 !-- 1591 1592 1593 1594 ! 1595 !-- 1596 1597 1598 1599 ! 1600 !-- 1601 1602 1603 1585 !--------------------------------------------------------------------------------------------------! 1586 SUBROUTINE deallocate_surface_attributes_h_top( surfaces ) 1587 1588 IMPLICIT NONE 1589 1590 1591 TYPE(surf_type) :: surfaces !< respective surface type 1592 1593 DEALLOCATE ( surfaces%start_index ) 1594 DEALLOCATE ( surfaces%end_index ) 1595 ! 1596 !-- Indices to locate surface (model-top) element 1597 DEALLOCATE ( surfaces%i ) 1598 DEALLOCATE ( surfaces%j ) 1599 DEALLOCATE ( surfaces%k ) 1600 1601 IF ( .NOT. constant_diffusion ) THEN 1602 DEALLOCATE ( surfaces%u_0 ) 1603 DEALLOCATE ( surfaces%v_0 ) 1604 ENDIF 1605 ! 1606 !-- Vertical momentum fluxes of u and v 1607 DEALLOCATE ( surfaces%usws ) 1608 DEALLOCATE ( surfaces%vsws ) 1609 ! 1610 !-- Sensible heat flux 1611 DEALLOCATE ( surfaces%shf ) 1612 ! 1613 !-- Latent heat flux 1614 IF ( humidity .OR. coupling_mode == 'ocean_to_atmosphere') THEN 1615 DEALLOCATE ( surfaces%qsws ) 1616 ENDIF 1617 ! 1618 !-- Scalar flux 1619 IF ( passive_scalar ) THEN 1620 DEALLOCATE ( surfaces%ssws ) 1621 ENDIF 1622 ! 1623 !-- Chemical species flux 1624 IF ( air_chemistry ) THEN 1625 DEALLOCATE ( surfaces%cssws ) 1626 ENDIF 1604 1627 ! 1605 1628 !-- 1606 1607 1608 1609 1629 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1630 DEALLOCATE ( surfaces%qcsws ) 1631 DEALLOCATE ( surfaces%ncsws ) 1632 ENDIF 1610 1633 ! 1611 1634 !-- 1612 1613 1614 1615 1635 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1636 DEALLOCATE ( surfaces%qrsws ) 1637 DEALLOCATE ( surfaces%nrsws ) 1638 ENDIF 1616 1639 1617 1640 ! 1618 1641 !-- 1619 1620 1621 1622 1623 ! 1624 !-- 1625 1626 1627 1628 1629 1630 !------------------------------------------------------------------------------ !1642 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 1643 DEALLOCATE ( surfaces%qisws ) 1644 DEALLOCATE ( surfaces%nisws ) 1645 ENDIF 1646 ! 1647 !-- Salinity flux 1648 IF ( ocean_mode ) DEALLOCATE ( surfaces%sasws ) 1649 1650 END SUBROUTINE deallocate_surface_attributes_h_top 1651 1652 1653 !--------------------------------------------------------------------------------------------------! 1631 1654 ! Description: 1632 1655 ! ------------ 1633 1656 !> Allocating memory for model-top fluxes 1634 !------------------------------------------------------------------------------! 1635 SUBROUTINE allocate_surface_attributes_h_top( surfaces, & 1636 nys_l, nyn_l, nxl_l, nxr_l ) 1637 1638 IMPLICIT NONE 1639 1640 INTEGER(iwp) :: nyn_l !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1641 INTEGER(iwp) :: nys_l !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1642 INTEGER(iwp) :: nxl_l !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1643 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1644 1645 TYPE(surf_type) :: surfaces !< respective surface type 1646 1647 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1648 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1649 surfaces%start_index = 0 1650 surfaces%end_index = -1 1651 ! 1652 !-- Indices to locate surface (model-top) element 1653 ALLOCATE ( surfaces%i(1:surfaces%ns) ) 1654 ALLOCATE ( surfaces%j(1:surfaces%ns) ) 1655 ALLOCATE ( surfaces%k(1:surfaces%ns) ) 1656 1657 IF ( .NOT. constant_diffusion ) THEN 1658 ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 1659 ALLOCATE ( surfaces%v_0(1:surfaces%ns) ) 1660 ENDIF 1661 ! 1662 !-- Vertical momentum fluxes of u and v 1663 ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 1664 ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 1665 ! 1666 !-- Sensible heat flux 1667 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1668 ! 1669 !-- Latent heat flux 1670 IF ( humidity .OR. coupling_mode == 'ocean_to_atmosphere') THEN 1671 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1672 ENDIF 1673 ! 1674 !-- Scalar flux 1675 IF ( passive_scalar ) THEN 1676 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1677 ENDIF 1678 ! 1679 !-- Chemical species flux 1680 IF ( air_chemistry ) THEN 1681 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1682 ENDIF 1657 !--------------------------------------------------------------------------------------------------! 1658 SUBROUTINE allocate_surface_attributes_h_top( surfaces, nys_l, nyn_l, nxl_l, nxr_l ) 1659 1660 IMPLICIT NONE 1661 1662 INTEGER(iwp) :: nyn_l !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1663 INTEGER(iwp) :: nys_l !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1664 INTEGER(iwp) :: nxl_l !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1665 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1666 1667 TYPE(surf_type) :: surfaces !< respective surface type 1668 1669 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1670 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1671 surfaces%start_index = 0 1672 surfaces%end_index = -1 1673 ! 1674 !-- Indices to locate surface (model-top) element 1675 ALLOCATE ( surfaces%i(1:surfaces%ns) ) 1676 ALLOCATE ( surfaces%j(1:surfaces%ns) ) 1677 ALLOCATE ( surfaces%k(1:surfaces%ns) ) 1678 1679 IF ( .NOT. constant_diffusion ) THEN 1680 ALLOCATE ( surfaces%u_0(1:surfaces%ns) ) 1681 ALLOCATE ( surfaces%v_0(1:surfaces%ns) ) 1682 ENDIF 1683 ! 1684 !-- Vertical momentum fluxes of u and v 1685 ALLOCATE ( surfaces%usws(1:surfaces%ns) ) 1686 ALLOCATE ( surfaces%vsws(1:surfaces%ns) ) 1687 ! 1688 !-- Sensible heat flux 1689 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1690 ! 1691 !-- Latent heat flux 1692 IF ( humidity .OR. coupling_mode == 'ocean_to_atmosphere') THEN 1693 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1694 ENDIF 1695 ! 1696 !-- Scalar flux 1697 IF ( passive_scalar ) THEN 1698 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1699 ENDIF 1700 ! 1701 !-- Chemical species flux 1702 IF ( air_chemistry ) THEN 1703 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1704 ENDIF 1683 1705 ! 1684 1706 !-- 1685 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN1686 1687 1688 1707 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison ) THEN 1708 ALLOCATE ( surfaces%qcsws(1:surfaces%ns) ) 1709 ALLOCATE ( surfaces%ncsws(1:surfaces%ns) ) 1710 ENDIF 1689 1711 ! 1690 1712 !-- 1691 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN1692 1693 1694 1713 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert ) THEN 1714 ALLOCATE ( surfaces%qrsws(1:surfaces%ns) ) 1715 ALLOCATE ( surfaces%nrsws(1:surfaces%ns) ) 1716 ENDIF 1695 1717 1696 1718 ! 1697 1719 !-- 1698 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN1699 1700 1701 1702 ! 1703 !-- 1704 1705 1706 1707 1708 1709 !------------------------------------------------------------------------------ !1720 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase ) THEN 1721 ALLOCATE ( surfaces%qisws(1:surfaces%ns) ) 1722 ALLOCATE ( surfaces%nisws(1:surfaces%ns) ) 1723 ENDIF 1724 ! 1725 !-- Salinity flux 1726 IF ( ocean_mode ) ALLOCATE ( surfaces%sasws(1:surfaces%ns) ) 1727 1728 END SUBROUTINE allocate_surface_attributes_h_top 1729 1730 1731 !--------------------------------------------------------------------------------------------------! 1710 1732 ! Description: 1711 1733 ! ------------ 1712 1734 !> Exit memory for model-top fluxes. 1713 !------------------------------------------------------------------------------ !1735 !--------------------------------------------------------------------------------------------------! 1714 1736 #if defined( _OPENACC ) 1715 SUBROUTINE exit_surface_attributes_h_top( surfaces ) 1716 1717 IMPLICIT NONE 1718 1719 TYPE(surf_type) :: surfaces !< respective surface type 1720 1737 SUBROUTINE exit_surface_attributes_h_top( surfaces ) 1738 1739 IMPLICIT NONE 1740 1741 TYPE(surf_type) :: surfaces !< respective surface type 1742 1743 !$ACC EXIT DATA & 1744 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1745 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1746 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1747 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1748 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1749 !$ACC DELETE(surfaces%usws(1:surfaces%ns)) & 1750 !$ACC DELETE(surfaces%vsws(1:surfaces%ns)) & 1751 !$ACC DELETE(surfaces%shf(1:surfaces%ns)) 1752 1753 IF ( .NOT. constant_diffusion ) THEN 1721 1754 !$ACC EXIT DATA & 1722 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 1723 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 1724 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 1725 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 1726 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 1727 !$ACC DELETE(surfaces%usws(1:surfaces%ns)) & 1728 !$ACC DELETE(surfaces%vsws(1:surfaces%ns)) & 1729 !$ACC DELETE(surfaces%shf(1:surfaces%ns)) 1730 1731 IF ( .NOT. constant_diffusion ) THEN 1732 !$ACC EXIT DATA & 1733 !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) & 1734 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1735 ENDIF 1736 1737 END SUBROUTINE exit_surface_attributes_h_top 1755 !$ACC DELETE(surfaces%u_0(1:surfaces%ns)) & 1756 !$ACC DELETE(surfaces%v_0(1:surfaces%ns)) 1757 ENDIF 1758 1759 END SUBROUTINE exit_surface_attributes_h_top 1738 1760 #endif 1739 1761 1740 !------------------------------------------------------------------------------ !1762 !--------------------------------------------------------------------------------------------------! 1741 1763 ! Description: 1742 1764 ! ------------ 1743 1765 !> Enter memory for model-top fluxes. 1744 !------------------------------------------------------------------------------ !1766 !--------------------------------------------------------------------------------------------------! 1745 1767 #if defined( _OPENACC ) 1746 SUBROUTINE enter_surface_attributes_h_top( surfaces ) 1747 1748 IMPLICIT NONE 1749 1750 TYPE(surf_type) :: surfaces !< respective surface type 1751 1768 SUBROUTINE enter_surface_attributes_h_top( surfaces ) 1769 1770 IMPLICIT NONE 1771 1772 TYPE(surf_type) :: surfaces !< respective surface type 1773 1774 !$ACC ENTER DATA & 1775 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1776 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1777 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1778 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1779 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1780 !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) & 1781 !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) & 1782 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) 1783 1784 IF ( .NOT. constant_diffusion ) THEN 1752 1785 !$ACC ENTER DATA & 1753 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 1754 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 1755 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 1756 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 1757 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 1758 !$ACC COPYIN(surfaces%usws(1:surfaces%ns)) & 1759 !$ACC COPYIN(surfaces%vsws(1:surfaces%ns)) & 1760 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) 1761 1762 IF ( .NOT. constant_diffusion ) THEN 1763 !$ACC ENTER DATA & 1764 !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) & 1765 !$ACC COPYIN(surfaces%v_0(1:surfaces%ns)) 1766 ENDIF 1767 1768 END SUBROUTINE enter_surface_attributes_h_top 1786 !$ACC COPYIN(surfaces%u_0(1:surfaces%ns)) & 1787 !$ACC COPYIN(surfaces%v_0(1:surfaces%ns)) 1788 ENDIF 1789 1790 END SUBROUTINE enter_surface_attributes_h_top 1769 1791 #endif 1770 1792 1771 !------------------------------------------------------------------------------ !1793 !--------------------------------------------------------------------------------------------------! 1772 1794 ! Description: 1773 1795 ! ------------ 1774 1796 !> Deallocating memory for vertical surface types. 1775 !------------------------------------------------------------------------------! 1776 SUBROUTINE deallocate_surface_attributes_v( surfaces ) 1777 1778 IMPLICIT NONE 1779 1780 1781 TYPE(surf_type) :: surfaces !< respective surface type 1782 1783 ! 1784 !-- Allocate arrays for start and end index of vertical surface type 1785 !-- for each (j,i)-grid point. This is required in diffion_x, which is 1786 !-- called for each (j,i). In order to find the location where the 1787 !-- respective flux is store within the surface-type, start- and end- 1788 !-- index are stored for each (j,i). For example, each (j,i) can have 1789 !-- several entries where fluxes for vertical surfaces might be stored. 1790 !-- In the flat case, where no vertical walls exit, set indicies such 1791 !-- that loop in diffusion routines will not be entered. 1792 DEALLOCATE ( surfaces%start_index ) 1793 DEALLOCATE ( surfaces%end_index ) 1794 ! 1795 !-- Indices to locate surface element. 1796 DEALLOCATE ( surfaces%i ) 1797 DEALLOCATE ( surfaces%j ) 1798 DEALLOCATE ( surfaces%k ) 1799 ! 1800 !-- Surface-layer height 1801 DEALLOCATE ( surfaces%z_mo ) 1802 ! 1803 !-- Surface orientation 1804 DEALLOCATE ( surfaces%facing ) 1805 ! 1806 !-- Surface parallel wind velocity 1807 DEALLOCATE ( surfaces%uvw_abs ) 1808 ! 1809 !-- Roughness 1810 DEALLOCATE ( surfaces%z0 ) 1811 DEALLOCATE ( surfaces%z0h ) 1812 DEALLOCATE ( surfaces%z0q ) 1813 1814 ! 1815 !-- Friction velocity 1816 DEALLOCATE ( surfaces%us ) 1817 ! 1818 !-- Allocate Obukhov length and bulk Richardson number. Actually, at 1819 !-- vertical surfaces these are only required for natural surfaces. 1820 !-- for natural land surfaces 1821 DEALLOCATE( surfaces%ol ) 1822 DEALLOCATE( surfaces%rib ) 1823 ! 1824 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- 1825 !-- and south-facing surfaces, for v at east- and west-facing surfaces. 1826 DEALLOCATE ( surfaces%mom_flux_uv ) 1827 ! 1828 !-- Allocate array for surface momentum flux for w - wsus and wsvs 1829 DEALLOCATE ( surfaces%mom_flux_w ) 1830 ! 1831 !-- Allocate array for surface momentum flux for subgrid-scale tke wsus and 1832 !-- wsvs; first index usvs or vsws, second index for wsus or wsvs, depending 1833 !-- on surface. 1834 DEALLOCATE ( surfaces%mom_flux_tke ) 1835 ! 1836 !-- Characteristic temperature and surface flux of sensible heat 1837 DEALLOCATE ( surfaces%ts ) 1838 DEALLOCATE ( surfaces%shf ) 1839 ! 1840 !-- surface temperature 1841 DEALLOCATE ( surfaces%pt_surface ) 1842 ! 1843 !-- Characteristic humidity and surface flux of latent heat 1844 IF ( humidity ) THEN 1845 DEALLOCATE ( surfaces%qs ) 1846 DEALLOCATE ( surfaces%qsws ) 1847 DEALLOCATE ( surfaces%q_surface ) 1848 DEALLOCATE ( surfaces%vpt_surface ) 1849 ENDIF 1850 ! 1851 !-- Characteristic scalar and surface flux of scalar 1852 IF ( passive_scalar ) THEN 1853 DEALLOCATE ( surfaces%ss ) 1854 DEALLOCATE ( surfaces%ssws ) 1855 ENDIF 1856 ! 1857 !-- Scaling parameter (cs*) and surface flux of chemical species 1858 IF ( air_chemistry ) THEN 1859 DEALLOCATE ( surfaces%css ) 1860 DEALLOCATE ( surfaces%cssws ) 1861 ENDIF 1862 ! 1863 !-- Arrays for storing potential temperature and 1864 !-- mixing ratio at first grid level 1865 DEALLOCATE ( surfaces%pt1 ) 1866 DEALLOCATE ( surfaces%qv1 ) 1867 DEALLOCATE ( surfaces%vpt1 ) 1868 1869 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1870 DEALLOCATE ( surfaces%qcs ) 1871 DEALLOCATE ( surfaces%ncs ) 1872 DEALLOCATE ( surfaces%qcsws ) 1873 DEALLOCATE ( surfaces%ncsws ) 1874 ENDIF 1875 1876 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1877 DEALLOCATE ( surfaces%qrs ) 1878 DEALLOCATE ( surfaces%nrs ) 1879 DEALLOCATE ( surfaces%qrsws ) 1880 DEALLOCATE ( surfaces%nrsws ) 1881 ENDIF 1882 1883 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 1884 DEALLOCATE ( surfaces%qis ) 1885 DEALLOCATE ( surfaces%nis ) 1886 DEALLOCATE ( surfaces%qisws ) 1887 DEALLOCATE ( surfaces%nisws ) 1888 ENDIF 1889 1890 ! 1891 !-- Salinity surface flux 1892 IF ( ocean_mode ) DEALLOCATE ( surfaces%sasws ) 1893 1894 END SUBROUTINE deallocate_surface_attributes_v 1895 1896 1897 !------------------------------------------------------------------------------! 1797 !--------------------------------------------------------------------------------------------------! 1798 SUBROUTINE deallocate_surface_attributes_v( surfaces ) 1799 1800 IMPLICIT NONE 1801 1802 1803 TYPE(surf_type) :: surfaces !< respective surface type 1804 1805 ! 1806 !-- Allocate arrays for start and end index of vertical surface type for each (j,i)-grid point. This 1807 !-- is required in diffion_x, which is called for each (j,i). In order to find the location where 1808 !-- the respective flux is store within the surface-type, start- and end-index are stored for each 1809 !-- (j,i). For example, each (j,i) can have several entries where fluxes for vertical surfaces might 1810 !-- be stored. In the flat case, where no vertical walls exit, set indicies such that loop in 1811 !-- diffusion routines will not be entered. 1812 DEALLOCATE ( surfaces%start_index ) 1813 DEALLOCATE ( surfaces%end_index ) 1814 ! 1815 !-- Indices to locate surface element. 1816 DEALLOCATE ( surfaces%i ) 1817 DEALLOCATE ( surfaces%j ) 1818 DEALLOCATE ( surfaces%k ) 1819 ! 1820 !-- Surface-layer height 1821 DEALLOCATE ( surfaces%z_mo ) 1822 ! 1823 !-- Surface orientation 1824 DEALLOCATE ( surfaces%facing ) 1825 ! 1826 !-- Surface parallel wind velocity 1827 DEALLOCATE ( surfaces%uvw_abs ) 1828 ! 1829 !-- Roughness 1830 DEALLOCATE ( surfaces%z0 ) 1831 DEALLOCATE ( surfaces%z0h ) 1832 DEALLOCATE ( surfaces%z0q ) 1833 1834 ! 1835 !-- Friction velocity 1836 DEALLOCATE ( surfaces%us ) 1837 ! 1838 !-- Allocate Obukhov length and bulk Richardson number. Actually, at vertical surfaces these are 1839 !-- only required for natural surfaces. 1840 !-- For natural land surfaces 1841 DEALLOCATE( surfaces%ol ) 1842 DEALLOCATE( surfaces%rib ) 1843 ! 1844 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- and south-facing 1845 !-- surfaces, for v at east- and west-facing surfaces. 1846 DEALLOCATE ( surfaces%mom_flux_uv ) 1847 ! 1848 !-- Allocate array for surface momentum flux for w - wsus and wsvs 1849 DEALLOCATE ( surfaces%mom_flux_w ) 1850 ! 1851 !-- Allocate array for surface momentum flux for subgrid-scale tke wsus and wsvs; first index usvs 1852 !-- or vsws, second index for wsus or wsvs, depending on surface. 1853 DEALLOCATE ( surfaces%mom_flux_tke ) 1854 ! 1855 !-- Characteristic temperature and surface flux of sensible heat 1856 DEALLOCATE ( surfaces%ts ) 1857 DEALLOCATE ( surfaces%shf ) 1858 ! 1859 !-- Surface temperature 1860 DEALLOCATE ( surfaces%pt_surface ) 1861 ! 1862 !-- Characteristic humidity and surface flux of latent heat 1863 IF ( humidity ) THEN 1864 DEALLOCATE ( surfaces%qs ) 1865 DEALLOCATE ( surfaces%qsws ) 1866 DEALLOCATE ( surfaces%q_surface ) 1867 DEALLOCATE ( surfaces%vpt_surface ) 1868 ENDIF 1869 ! 1870 !-- Characteristic scalar and surface flux of scalar 1871 IF ( passive_scalar ) THEN 1872 DEALLOCATE ( surfaces%ss ) 1873 DEALLOCATE ( surfaces%ssws ) 1874 ENDIF 1875 ! 1876 !-- Scaling parameter (cs*) and surface flux of chemical species 1877 IF ( air_chemistry ) THEN 1878 DEALLOCATE ( surfaces%css ) 1879 DEALLOCATE ( surfaces%cssws ) 1880 ENDIF 1881 ! 1882 !-- Arrays for storing potential temperature and mixing ratio at first grid level 1883 DEALLOCATE ( surfaces%pt1 ) 1884 DEALLOCATE ( surfaces%qv1 ) 1885 DEALLOCATE ( surfaces%vpt1 ) 1886 1887 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 1888 DEALLOCATE ( surfaces%qcs ) 1889 DEALLOCATE ( surfaces%ncs ) 1890 DEALLOCATE ( surfaces%qcsws ) 1891 DEALLOCATE ( surfaces%ncsws ) 1892 ENDIF 1893 1894 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 1895 DEALLOCATE ( surfaces%qrs ) 1896 DEALLOCATE ( surfaces%nrs ) 1897 DEALLOCATE ( surfaces%qrsws ) 1898 DEALLOCATE ( surfaces%nrsws ) 1899 ENDIF 1900 1901 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 1902 DEALLOCATE ( surfaces%qis ) 1903 DEALLOCATE ( surfaces%nis ) 1904 DEALLOCATE ( surfaces%qisws ) 1905 DEALLOCATE ( surfaces%nisws ) 1906 ENDIF 1907 1908 ! 1909 !-- Salinity surface flux 1910 IF ( ocean_mode ) DEALLOCATE ( surfaces%sasws ) 1911 1912 END SUBROUTINE deallocate_surface_attributes_v 1913 1914 1915 !--------------------------------------------------------------------------------------------------! 1898 1916 ! Description: 1899 1917 ! ------------ 1900 1918 !> Allocating memory for vertical surface types. 1901 !------------------------------------------------------------------------------! 1902 SUBROUTINE allocate_surface_attributes_v( surfaces, & 1903 nys_l, nyn_l, nxl_l, nxr_l ) 1904 1905 IMPLICIT NONE 1906 1907 INTEGER(iwp) :: nyn_l !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1908 INTEGER(iwp) :: nys_l !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1909 INTEGER(iwp) :: nxl_l !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1910 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1911 1912 TYPE(surf_type) :: surfaces !< respective surface type 1913 1914 ! 1915 !-- Allocate arrays for start and end index of vertical surface type 1916 !-- for each (j,i)-grid point. This is required in diffion_x, which is 1917 !-- called for each (j,i). In order to find the location where the 1918 !-- respective flux is store within the surface-type, start- and end- 1919 !-- index are stored for each (j,i). For example, each (j,i) can have 1920 !-- several entries where fluxes for vertical surfaces might be stored. 1921 !-- In the flat case, where no vertical walls exit, set indicies such 1922 !-- that loop in diffusion routines will not be entered. 1923 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1924 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1925 surfaces%start_index = 0 1926 surfaces%end_index = -1 1927 ! 1928 !-- Indices to locate surface element. 1929 ALLOCATE ( surfaces%i(1:surfaces%ns) ) 1930 ALLOCATE ( surfaces%j(1:surfaces%ns) ) 1931 ALLOCATE ( surfaces%k(1:surfaces%ns) ) 1932 ! 1933 !-- Surface-layer height 1934 ALLOCATE ( surfaces%z_mo(1:surfaces%ns) ) 1935 ! 1936 !-- Surface orientation 1937 ALLOCATE ( surfaces%facing(1:surfaces%ns) ) 1938 ! 1939 !-- Surface parallel wind velocity 1940 ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) ) 1941 ! 1942 !-- Roughness 1943 ALLOCATE ( surfaces%z0(1:surfaces%ns) ) 1944 ALLOCATE ( surfaces%z0h(1:surfaces%ns) ) 1945 ALLOCATE ( surfaces%z0q(1:surfaces%ns) ) 1946 1947 ! 1948 !-- Friction velocity 1949 ALLOCATE ( surfaces%us(1:surfaces%ns) ) 1950 ! 1951 !-- Allocate Obukhov length and bulk Richardson number. Actually, at 1952 !-- vertical surfaces these are only required for natural surfaces. 1953 !-- for natural land surfaces 1954 ALLOCATE( surfaces%ol(1:surfaces%ns) ) 1955 ALLOCATE( surfaces%rib(1:surfaces%ns) ) 1956 ! 1957 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- 1958 !-- and south-facing surfaces, for v at east- and west-facing surfaces. 1959 ALLOCATE ( surfaces%mom_flux_uv(1:surfaces%ns) ) 1960 ! 1961 !-- Allocate array for surface momentum flux for w - wsus and wsvs 1962 ALLOCATE ( surfaces%mom_flux_w(1:surfaces%ns) ) 1963 ! 1964 !-- Allocate array for surface momentum flux for subgrid-scale tke wsus and 1965 !-- wsvs; first index usvs or vsws, second index for wsus or wsvs, depending 1966 !-- on surface. 1967 ALLOCATE ( surfaces%mom_flux_tke(0:1,1:surfaces%ns) ) 1968 ! 1969 !-- Characteristic temperature and surface flux of sensible heat 1970 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 1971 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1972 ! 1973 !-- surface temperature 1974 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 1975 ! 1976 !-- Characteristic humidity and surface flux of latent heat 1977 IF ( humidity ) THEN 1978 ALLOCATE ( surfaces%qs(1:surfaces%ns) ) 1979 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1980 ALLOCATE ( surfaces%q_surface(1:surfaces%ns) ) 1981 ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) ) 1982 ENDIF 1983 ! 1984 !-- Characteristic scalar and surface flux of scalar 1985 IF ( passive_scalar ) THEN 1986 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 1987 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 1988 ENDIF 1989 ! 1990 !-- Scaling parameter (cs*) and surface flux of chemical species 1991 IF ( air_chemistry ) THEN 1992 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 1993 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 1994 ENDIF 1995 ! 1996 !-- Arrays for storing potential temperature and 1997 !-- mixing ratio at first grid level 1998 ALLOCATE ( surfaces%pt1(1:surfaces%ns) ) 1999 ALLOCATE ( surfaces%qv1(1:surfaces%ns) ) 2000 ALLOCATE ( surfaces%vpt1(1:surfaces%ns) ) 2001 2002 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 2003 ALLOCATE ( surfaces%qcs(1:surfaces%ns) ) 2004 ALLOCATE ( surfaces%ncs(1:surfaces%ns) ) 2005 ALLOCATE ( surfaces%qcsws(1:surfaces%ns) ) 2006 ALLOCATE ( surfaces%ncsws(1:surfaces%ns) ) 2007 ENDIF 2008 2009 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 2010 ALLOCATE ( surfaces%qrs(1:surfaces%ns) ) 2011 ALLOCATE ( surfaces%nrs(1:surfaces%ns) ) 2012 ALLOCATE ( surfaces%qrsws(1:surfaces%ns) ) 2013 ALLOCATE ( surfaces%nrsws(1:surfaces%ns) ) 2014 ENDIF 2015 2016 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 2017 ALLOCATE ( surfaces%qis(1:surfaces%ns) ) 2018 ALLOCATE ( surfaces%nis(1:surfaces%ns) ) 2019 ALLOCATE ( surfaces%qisws(1:surfaces%ns) ) 2020 ALLOCATE ( surfaces%nisws(1:surfaces%ns) ) 2021 ENDIF 2022 ! 2023 !-- Salinity surface flux 2024 IF ( ocean_mode ) ALLOCATE ( surfaces%sasws(1:surfaces%ns) ) 2025 2026 END SUBROUTINE allocate_surface_attributes_v 2027 2028 2029 !------------------------------------------------------------------------------! 1919 !--------------------------------------------------------------------------------------------------! 1920 SUBROUTINE allocate_surface_attributes_v( surfaces, nys_l, nyn_l, nxl_l, nxr_l ) 1921 1922 IMPLICIT NONE 1923 1924 INTEGER(iwp) :: nyn_l !< north bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1925 INTEGER(iwp) :: nys_l !< south bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1926 INTEGER(iwp) :: nxl_l !< west bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1927 INTEGER(iwp) :: nxr_l !< east bound of local 2d array start/end_index, is equal to nyn, except for restart-array 1928 1929 TYPE(surf_type) :: surfaces !< respective surface type 1930 1931 ! 1932 !-- Allocate arrays for start and end index of vertical surface type for each (j,i)-grid point. This 1933 !-- is required in diffion_x, which is called for each (j,i). In order to find the location where 1934 !-- the respective flux is store within the surface-type, start- and end-index are stored for each 1935 !-- (j,i). For example, each (j,i) can have several entries where fluxes for vertical surfaces might 1936 !-- be stored. In the flat case, where no vertical walls exit, set indicies such that loop in 1937 !-- diffusion routines will not be entered. 1938 ALLOCATE ( surfaces%start_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1939 ALLOCATE ( surfaces%end_index(nys_l:nyn_l,nxl_l:nxr_l) ) 1940 surfaces%start_index = 0 1941 surfaces%end_index = -1 1942 ! 1943 !-- Indices to locate surface element. 1944 ALLOCATE ( surfaces%i(1:surfaces%ns) ) 1945 ALLOCATE ( surfaces%j(1:surfaces%ns) ) 1946 ALLOCATE ( surfaces%k(1:surfaces%ns) ) 1947 ! 1948 !-- Surface-layer height 1949 ALLOCATE ( surfaces%z_mo(1:surfaces%ns) ) 1950 ! 1951 !-- Surface orientation 1952 ALLOCATE ( surfaces%facing(1:surfaces%ns) ) 1953 ! 1954 !-- Surface parallel wind velocity 1955 ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) ) 1956 ! 1957 !-- Roughness 1958 ALLOCATE ( surfaces%z0(1:surfaces%ns) ) 1959 ALLOCATE ( surfaces%z0h(1:surfaces%ns) ) 1960 ALLOCATE ( surfaces%z0q(1:surfaces%ns) ) 1961 1962 ! 1963 !-- Friction velocity 1964 ALLOCATE ( surfaces%us(1:surfaces%ns) ) 1965 ! 1966 !-- Allocate Obukhov length and bulk Richardson number. Actually, at vertical surfaces these are 1967 !-- only required for natural surfaces. 1968 !-- For natural land surfaces 1969 ALLOCATE( surfaces%ol(1:surfaces%ns) ) 1970 ALLOCATE( surfaces%rib(1:surfaces%ns) ) 1971 ! 1972 !-- Allocate arrays for surface momentum fluxes for u and v. For u at north- and south-facing 1973 !-- surfaces, for v at east- and west-facing surfaces. 1974 ALLOCATE ( surfaces%mom_flux_uv(1:surfaces%ns) ) 1975 ! 1976 !-- Allocate array for surface momentum flux for w - wsus and wsvs 1977 ALLOCATE ( surfaces%mom_flux_w(1:surfaces%ns) ) 1978 ! 1979 !-- Allocate array for surface momentum flux for subgrid-scale tke wsus and wsvs; first index usvs 1980 !-- or vsws, second index for wsus or wsvs, depending on surface. 1981 ALLOCATE ( surfaces%mom_flux_tke(0:1,1:surfaces%ns) ) 1982 ! 1983 !-- Characteristic temperature and surface flux of sensible heat 1984 ALLOCATE ( surfaces%ts(1:surfaces%ns) ) 1985 ALLOCATE ( surfaces%shf(1:surfaces%ns) ) 1986 ! 1987 !-- Surface temperature 1988 ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) ) 1989 ! 1990 !-- Characteristic humidity and surface flux of latent heat 1991 IF ( humidity ) THEN 1992 ALLOCATE ( surfaces%qs(1:surfaces%ns) ) 1993 ALLOCATE ( surfaces%qsws(1:surfaces%ns) ) 1994 ALLOCATE ( surfaces%q_surface(1:surfaces%ns) ) 1995 ALLOCATE ( surfaces%vpt_surface(1:surfaces%ns) ) 1996 ENDIF 1997 ! 1998 !-- Characteristic scalar and surface flux of scalar 1999 IF ( passive_scalar ) THEN 2000 ALLOCATE ( surfaces%ss(1:surfaces%ns) ) 2001 ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 2002 ENDIF 2003 ! 2004 !-- Scaling parameter (cs*) and surface flux of chemical species 2005 IF ( air_chemistry ) THEN 2006 ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) ) 2007 ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 2008 ENDIF 2009 ! 2010 !-- Arrays for storing potential temperature and mixing ratio at first grid level 2011 ALLOCATE ( surfaces%pt1(1:surfaces%ns) ) 2012 ALLOCATE ( surfaces%qv1(1:surfaces%ns) ) 2013 ALLOCATE ( surfaces%vpt1(1:surfaces%ns) ) 2014 2015 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 2016 ALLOCATE ( surfaces%qcs(1:surfaces%ns) ) 2017 ALLOCATE ( surfaces%ncs(1:surfaces%ns) ) 2018 ALLOCATE ( surfaces%qcsws(1:surfaces%ns) ) 2019 ALLOCATE ( surfaces%ncsws(1:surfaces%ns) ) 2020 ENDIF 2021 2022 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 2023 ALLOCATE ( surfaces%qrs(1:surfaces%ns) ) 2024 ALLOCATE ( surfaces%nrs(1:surfaces%ns) ) 2025 ALLOCATE ( surfaces%qrsws(1:surfaces%ns) ) 2026 ALLOCATE ( surfaces%nrsws(1:surfaces%ns) ) 2027 ENDIF 2028 2029 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 2030 ALLOCATE ( surfaces%qis(1:surfaces%ns) ) 2031 ALLOCATE ( surfaces%nis(1:surfaces%ns) ) 2032 ALLOCATE ( surfaces%qisws(1:surfaces%ns) ) 2033 ALLOCATE ( surfaces%nisws(1:surfaces%ns) ) 2034 ENDIF 2035 ! 2036 !-- Salinity surface flux 2037 IF ( ocean_mode ) ALLOCATE ( surfaces%sasws(1:surfaces%ns) ) 2038 2039 END SUBROUTINE allocate_surface_attributes_v 2040 2041 2042 !--------------------------------------------------------------------------------------------------! 2030 2043 ! Description: 2031 2044 ! ------------ 2032 2045 !> Exit memory for vertical surface types. 2033 !------------------------------------------------------------------------------ !2046 !--------------------------------------------------------------------------------------------------! 2034 2047 #if defined( _OPENACC ) 2035 2036 2037 2038 2039 2040 2041 2042 2043 2044 2045 2046 2047 2048 2049 2050 2051 2052 2053 2054 2055 2056 2057 2058 2048 SUBROUTINE exit_surface_attributes_v( surfaces ) 2049 2050 IMPLICIT NONE 2051 2052 TYPE(surf_type) :: surfaces !< respective surface type 2053 2054 !$ACC EXIT DATA & 2055 !$ACC DELETE(surfaces%start_index(nys:nyn,nxl:nxr)) & 2056 !$ACC DELETE(surfaces%end_index(nys:nyn,nxl:nxr)) & 2057 !$ACC DELETE(surfaces%i(1:surfaces%ns)) & 2058 !$ACC DELETE(surfaces%j(1:surfaces%ns)) & 2059 !$ACC DELETE(surfaces%k(1:surfaces%ns)) & 2060 !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) & 2061 !$ACC DELETE(surfaces%z0(1:surfaces%ns)) & 2062 !$ACC DELETE(surfaces%rib(1:surfaces%ns)) & 2063 !$ACC DELETE(surfaces%mom_flux_uv(1:surfaces%ns)) & 2064 !$ACC DELETE(surfaces%mom_flux_w(1:surfaces%ns)) & 2065 !$ACC DELETE(surfaces%mom_flux_tke(0:1,1:surfaces%ns)) & 2066 !$ACC DELETE(surfaces%ts(1:surfaces%ns)) & 2067 !$ACC DELETE(surfaces%shf(1:surfaces%ns)) & 2068 !$ACC DELETE(surfaces%pt1(1:surfaces%ns)) & 2069 !$ACC DELETE(surfaces%qv1(1:surfaces%ns)) 2070 2071 END SUBROUTINE exit_surface_attributes_v 2059 2072 #endif 2060 2073 2061 !------------------------------------------------------------------------------ !2074 !--------------------------------------------------------------------------------------------------! 2062 2075 ! Description: 2063 2076 ! ------------ 2064 2077 !> Enter memory for vertical surface types. 2065 !------------------------------------------------------------------------------ !2078 !--------------------------------------------------------------------------------------------------! 2066 2079 #if defined( _OPENACC ) 2067 2068 2069 2070 2071 2072 2073 2074 2075 2076 2077 2078 2079 2080 2081 2082 2083 2084 2085 2086 2087 2088 2089 2090 2080 SUBROUTINE enter_surface_attributes_v( surfaces ) 2081 2082 IMPLICIT NONE 2083 2084 TYPE(surf_type) :: surfaces !< respective surface type 2085 2086 !$ACC ENTER DATA & 2087 !$ACC COPYIN(surfaces%start_index(nys:nyn,nxl:nxr)) & 2088 !$ACC COPYIN(surfaces%end_index(nys:nyn,nxl:nxr)) & 2089 !$ACC COPYIN(surfaces%i(1:surfaces%ns)) & 2090 !$ACC COPYIN(surfaces%j(1:surfaces%ns)) & 2091 !$ACC COPYIN(surfaces%k(1:surfaces%ns)) & 2092 !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) & 2093 !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) & 2094 !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) & 2095 !$ACC COPYIN(surfaces%mom_flux_uv(1:surfaces%ns)) & 2096 !$ACC COPYIN(surfaces%mom_flux_w(1:surfaces%ns)) & 2097 !$ACC COPYIN(surfaces%mom_flux_tke(0:1,1:surfaces%ns)) & 2098 !$ACC COPYIN(surfaces%ts(1:surfaces%ns)) & 2099 !$ACC COPYIN(surfaces%shf(1:surfaces%ns)) & 2100 !$ACC COPYIN(surfaces%pt1(1:surfaces%ns)) & 2101 !$ACC COPYIN(surfaces%qv1(1:surfaces%ns)) 2102 2103 END SUBROUTINE enter_surface_attributes_v 2091 2104 #endif 2092 2105 2093 !------------------------------------------------------------------------------ !2106 !--------------------------------------------------------------------------------------------------! 2094 2107 ! Description: 2095 2108 ! ------------ 2096 !> Initialize surface elements, i.e. set initial values for surface fluxes, 2097 !> friction velocity, calcuation of start/end indices, etc. . 2098 !> Please note, further initialization concerning 2099 !> special surface characteristics, e.g. soil- and vegatation type, 2100 !> building type, etc., is done in the land-surface and urban-surface module, 2101 !> respectively. 2102 !------------------------------------------------------------------------------! 2103 SUBROUTINE init_surfaces 2104 2105 IMPLICIT NONE 2106 2107 INTEGER(iwp) :: i !< running index x-direction 2108 INTEGER(iwp) :: j !< running index y-direction 2109 INTEGER(iwp) :: k !< running index z-direction 2110 2111 INTEGER(iwp) :: start_index_lsm_h !< dummy to determing local start index in surface type for given (j,i), for horizontal natural surfaces 2112 INTEGER(iwp) :: start_index_usm_h !< dummy to determing local start index in surface type for given (j,i), for horizontal urban surfaces 2113 2114 INTEGER(iwp) :: num_lsm_h !< current number of horizontal surface element, natural type 2115 INTEGER(iwp) :: num_lsm_h_kji !< dummy to determing local end index in surface type for given (j,i), for for horizonal natural surfaces 2116 INTEGER(iwp) :: num_usm_h !< current number of horizontal surface element, urban type 2117 INTEGER(iwp) :: num_usm_h_kji !< dummy to determing local end index in surface type for given (j,i), for for horizonal urban surfaces 2118 2119 INTEGER(iwp), DIMENSION(0:2) :: num_def_h !< current number of horizontal surface element, default type 2120 INTEGER(iwp), DIMENSION(0:2) :: num_def_h_kji !< dummy to determing local end index in surface type for given (j,i), for horizonal default surfaces 2121 INTEGER(iwp), DIMENSION(0:2) :: start_index_def_h !< dummy to determing local start index in surface type for given (j,i), for horizontal default surfaces 2122 2123 INTEGER(iwp), DIMENSION(0:3) :: num_def_v !< current number of vertical surface element, default type 2124 INTEGER(iwp), DIMENSION(0:3) :: num_def_v_kji !< dummy to determing local end index in surface type for given (j,i), for vertical default surfaces 2125 INTEGER(iwp), DIMENSION(0:3) :: num_lsm_v !< current number of vertical surface element, natural type 2126 INTEGER(iwp), DIMENSION(0:3) :: num_lsm_v_kji !< dummy to determing local end index in surface type for given (j,i), for vertical natural surfaces 2127 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v !< current number of vertical surface element, urban type 2128 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v_kji !< dummy to determing local end index in surface type for given (j,i), for vertical urban surfaces 2129 2130 INTEGER(iwp), DIMENSION(0:3) :: start_index_def_v !< dummy to determing local start index in surface type for given (j,i), for vertical default surfaces 2131 INTEGER(iwp), DIMENSION(0:3) :: start_index_lsm_v !< dummy to determing local start index in surface type for given (j,i), for vertical natural surfaces 2132 INTEGER(iwp), DIMENSION(0:3) :: start_index_usm_v !< dummy to determing local start index in surface type for given (j,i), for vertical urban surfaces 2133 2134 LOGICAL :: building !< flag indicating building grid point 2135 LOGICAL :: terrain !< flag indicating natural terrain grid point 2136 LOGICAL :: unresolved_building !< flag indicating a grid point where actually a building is defined but not resolved by the vertical grid 2137 ! 2138 !-- Set offset indices, i.e. index difference between surface element and 2139 !-- surface-bounded grid point. 2140 !-- Upward facing - no horizontal offsets 2141 surf_def_h(0:2)%ioff = 0 2142 surf_def_h(0:2)%joff = 0 2143 2144 surf_lsm_h%ioff = 0 2145 surf_lsm_h%joff = 0 2146 2147 surf_usm_h%ioff = 0 2148 surf_usm_h%joff = 0 2149 ! 2150 !-- Upward facing vertical offsets 2151 surf_def_h(0)%koff = -1 2152 surf_lsm_h%koff = -1 2153 surf_usm_h%koff = -1 2154 ! 2155 !-- Downward facing vertical offset 2156 surf_def_h(1:2)%koff = 1 2157 ! 2158 !-- Vertical surfaces - no vertical offset 2159 surf_def_v(0:3)%koff = 0 2160 surf_lsm_v(0:3)%koff = 0 2161 surf_usm_v(0:3)%koff = 0 2162 ! 2163 !-- North- and southward facing - no offset in x 2164 surf_def_v(0:1)%ioff = 0 2165 surf_lsm_v(0:1)%ioff = 0 2166 surf_usm_v(0:1)%ioff = 0 2167 ! 2168 !-- Northward facing offset in y 2169 surf_def_v(0)%joff = -1 2170 surf_lsm_v(0)%joff = -1 2171 surf_usm_v(0)%joff = -1 2172 ! 2173 !-- Southward facing offset in y 2174 surf_def_v(1)%joff = 1 2175 surf_lsm_v(1)%joff = 1 2176 surf_usm_v(1)%joff = 1 2177 2178 ! 2179 !-- East- and westward facing - no offset in y 2180 surf_def_v(2:3)%joff = 0 2181 surf_lsm_v(2:3)%joff = 0 2182 surf_usm_v(2:3)%joff = 0 2183 ! 2184 !-- Eastward facing offset in x 2185 surf_def_v(2)%ioff = -1 2186 surf_lsm_v(2)%ioff = -1 2187 surf_usm_v(2)%ioff = -1 2188 ! 2189 !-- Westward facing offset in y 2190 surf_def_v(3)%ioff = 1 2191 surf_lsm_v(3)%ioff = 1 2192 surf_usm_v(3)%ioff = 1 2193 2194 ! 2195 !-- Initialize surface attributes, store indicies, surfaces orientation, etc., 2196 num_def_h(0:2) = 1 2197 num_def_v(0:3) = 1 2198 2199 num_lsm_h = 1 2200 num_lsm_v(0:3) = 1 2201 2202 num_usm_h = 1 2203 num_usm_v(0:3) = 1 2204 2205 start_index_def_h(0:2) = 1 2206 start_index_def_v(0:3) = 1 2207 2208 start_index_lsm_h = 1 2209 start_index_lsm_v(0:3) = 1 2210 2211 start_index_usm_h = 1 2212 start_index_usm_v(0:3) = 1 2213 2214 DO i = nxl, nxr 2215 DO j = nys, nyn 2216 2217 num_def_h_kji = 0 2218 num_def_v_kji = 0 2219 num_lsm_h_kji = 0 2220 num_lsm_v_kji = 0 2221 num_usm_h_kji = 0 2222 num_usm_v_kji = 0 2223 2224 DO k = nzb+1, nzt 2225 ! 2226 !-- Check if current gridpoint belongs to the atmosphere 2227 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 2228 ! 2229 !-- Upward-facing surface. Distinguish between differet surface types. 2230 !-- To do, think about method to flag natural and non-natural 2109 !> Initialize surface elements, i.e. set initial values for surface fluxes, friction velocity, 2110 !> calcuation of start/end indices, etc. Please note, further initialization concerning special 2111 !> surface characteristics, e.g. soil- and vegatation type, building type, etc., 2112 !> is done in the land-surface and urban-surface module, respectively. 2113 !--------------------------------------------------------------------------------------------------! 2114 SUBROUTINE init_surfaces 2115 2116 IMPLICIT NONE 2117 2118 INTEGER(iwp) :: i !< running index x-direction 2119 INTEGER(iwp) :: j !< running index y-direction 2120 INTEGER(iwp) :: k !< running index z-direction 2121 2122 INTEGER(iwp) :: start_index_lsm_h !< dummy to determing local start index in surface type for given (j,i), for horizontal 2123 !< natural surfaces 2124 INTEGER(iwp) :: start_index_usm_h !< dummy to determing local start index in surface type for given (j,i), for horizontal 2125 !< urban surfaces 2126 2127 INTEGER(iwp) :: num_lsm_h !< current number of horizontal surface element, natural type 2128 INTEGER(iwp) :: num_lsm_h_kji !< dummy to determing local end index in surface type for given (j,i), for for horizonal 2129 !< natural surfaces 2130 INTEGER(iwp) :: num_usm_h !< current number of horizontal surface element, urban type 2131 INTEGER(iwp) :: num_usm_h_kji !< dummy to determing local end index in surface type for given (j,i), for for horizonal urban 2132 !< surfaces 2133 2134 INTEGER(iwp), DIMENSION(0:2) :: num_def_h !< current number of horizontal surface element, default type 2135 INTEGER(iwp), DIMENSION(0:2) :: num_def_h_kji !< dummy to determing local end index in surface type for given (j,i), 2136 !< for horizonal default surfaces 2137 INTEGER(iwp), DIMENSION(0:2) :: start_index_def_h !< dummy to determing local start index in surface type for given (j,i), 2138 !< for horizontal default surfaces 2139 2140 INTEGER(iwp), DIMENSION(0:3) :: num_def_v !< current number of vertical surface element, default type 2141 INTEGER(iwp), DIMENSION(0:3) :: num_def_v_kji !< dummy to determing local end index in surface type for given (j,i), 2142 !< for vertical default surfaces 2143 INTEGER(iwp), DIMENSION(0:3) :: num_lsm_v !< current number of vertical surface element, natural type 2144 INTEGER(iwp), DIMENSION(0:3) :: num_lsm_v_kji !< dummy to determing local end index in surface type for given (j,i), 2145 !< for vertical natural surfaces 2146 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v !< current number of vertical surface element, urban type 2147 INTEGER(iwp), DIMENSION(0:3) :: num_usm_v_kji !< dummy to determing local end index in surface type for given (j,i), 2148 !< for vertical urban surfaces 2149 2150 INTEGER(iwp), DIMENSION(0:3) :: start_index_def_v !< dummy to determing local start index in surface type for given (j,i), 2151 !< for vertical default surfaces 2152 INTEGER(iwp), DIMENSION(0:3) :: start_index_lsm_v !< dummy to determing local start index in surface type for given (j,i), 2153 !< for vertical natural surfaces 2154 INTEGER(iwp), DIMENSION(0:3) :: start_index_usm_v !< dummy to determing local start index in surface type for given (j,i), 2155 !< for vertical urban surfaces 2156 2157 LOGICAL :: building !< flag indicating building grid point 2158 LOGICAL :: terrain !< flag indicating natural terrain grid point 2159 LOGICAL :: unresolved_building !< flag indicating a grid point where actually a building is defined but not resolved by the 2160 !< vertical grid 2161 ! 2162 !-- Set offset indices, i.e. index difference between surface element and surface-bounded grid point. 2163 !-- Upward facing - no horizontal offsets 2164 surf_def_h(0:2)%ioff = 0 2165 surf_def_h(0:2)%joff = 0 2166 2167 surf_lsm_h%ioff = 0 2168 surf_lsm_h%joff = 0 2169 2170 surf_usm_h%ioff = 0 2171 surf_usm_h%joff = 0 2172 ! 2173 !-- Upward facing vertical offsets 2174 surf_def_h(0)%koff = -1 2175 surf_lsm_h%koff = -1 2176 surf_usm_h%koff = -1 2177 ! 2178 !-- Downward facing vertical offset 2179 surf_def_h(1:2)%koff = 1 2180 ! 2181 !-- Vertical surfaces - no vertical offset 2182 surf_def_v(0:3)%koff = 0 2183 surf_lsm_v(0:3)%koff = 0 2184 surf_usm_v(0:3)%koff = 0 2185 ! 2186 !-- North- and southward facing - no offset in x 2187 surf_def_v(0:1)%ioff = 0 2188 surf_lsm_v(0:1)%ioff = 0 2189 surf_usm_v(0:1)%ioff = 0 2190 ! 2191 !-- Northward facing offset in y 2192 surf_def_v(0)%joff = -1 2193 surf_lsm_v(0)%joff = -1 2194 surf_usm_v(0)%joff = -1 2195 ! 2196 !-- Southward facing offset in y 2197 surf_def_v(1)%joff = 1 2198 surf_lsm_v(1)%joff = 1 2199 surf_usm_v(1)%joff = 1 2200 2201 ! 2202 !-- East- and westward facing - no offset in y 2203 surf_def_v(2:3)%joff = 0 2204 surf_lsm_v(2:3)%joff = 0 2205 surf_usm_v(2:3)%joff = 0 2206 ! 2207 !-- Eastward facing offset in x 2208 surf_def_v(2)%ioff = -1 2209 surf_lsm_v(2)%ioff = -1 2210 surf_usm_v(2)%ioff = -1 2211 ! 2212 !-- Westward facing offset in y 2213 surf_def_v(3)%ioff = 1 2214 surf_lsm_v(3)%ioff = 1 2215 surf_usm_v(3)%ioff = 1 2216 2217 ! 2218 !-- Initialize surface attributes, store indicies, surfaces orientation, etc., 2219 num_def_h(0:2) = 1 2220 num_def_v(0:3) = 1 2221 2222 num_lsm_h = 1 2223 num_lsm_v(0:3) = 1 2224 2225 num_usm_h = 1 2226 num_usm_v(0:3) = 1 2227 2228 start_index_def_h(0:2) = 1 2229 start_index_def_v(0:3) = 1 2230 2231 start_index_lsm_h = 1 2232 start_index_lsm_v(0:3) = 1 2233 2234 start_index_usm_h = 1 2235 start_index_usm_v(0:3) = 1 2236 2237 DO i = nxl, nxr 2238 DO j = nys, nyn 2239 num_def_h_kji = 0 2240 num_def_v_kji = 0 2241 num_lsm_h_kji = 0 2242 num_lsm_v_kji = 0 2243 num_usm_h_kji = 0 2244 num_usm_v_kji = 0 2245 2246 DO k = nzb+1, nzt 2247 ! 2248 !-- Check if current gridpoint belongs to the atmosphere 2249 IF ( BTEST( wall_flags_total_0(k,j,i), 0 ) ) THEN 2250 ! 2251 !-- Upward-facing surface. Distinguish between differet surface types. 2252 !-- To do, think about method to flag natural and non-natural surfaces. 2253 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i), 0 ) ) THEN 2254 ! 2255 !-- Determine flags indicating terrain or building 2256 terrain = BTEST( wall_flags_total_0(k-1,j,i), 5 ) .OR. topo_no_distinct 2257 building = BTEST( wall_flags_total_0(k-1,j,i), 6 ) .OR. topo_no_distinct 2258 2259 ! 2260 !-- Unresolved_building indicates a surface with equal height as terrain but with a 2261 !-- non-grid resolved building on top. These surfaces will be flagged as urban 2231 2262 !-- surfaces. 2232 IF ( .NOT. BTEST( wall_flags_total_0(k-1,j,i), 0 ) ) THEN 2233 ! 2234 !-- Determine flags indicating terrain or building 2235 terrain = BTEST( wall_flags_total_0(k-1,j,i), 5 ) .OR. & 2236 topo_no_distinct 2237 building = BTEST( wall_flags_total_0(k-1,j,i), 6 ) .OR. & 2238 topo_no_distinct 2239 2240 ! 2241 !-- unresolved_building indicates a surface with equal height 2242 !-- as terrain but with a non-grid resolved building on top. 2243 !-- These surfaces will be flagged as urban surfaces. 2244 unresolved_building = BTEST( wall_flags_total_0(k-1,j,i), 5 ) & 2245 .AND. BTEST( wall_flags_total_0(k-1,j,i), 6 ) 2246 ! 2247 !-- Natural surface type 2248 IF ( land_surface .AND. terrain .AND. & 2249 .NOT. unresolved_building ) THEN 2250 CALL initialize_horizontal_surfaces( k, j, i, & 2251 surf_lsm_h, & 2252 num_lsm_h, & 2253 num_lsm_h_kji, & 2254 .TRUE., .FALSE. ) 2255 ! 2256 !-- Urban surface tpye 2257 ELSEIF ( urban_surface .AND. building ) THEN 2258 CALL initialize_horizontal_surfaces( k, j, i, & 2259 surf_usm_h, & 2260 num_usm_h, & 2261 num_usm_h_kji, & 2262 .TRUE., .FALSE. ) 2263 ! 2264 !-- Default surface type 2265 ELSE 2266 CALL initialize_horizontal_surfaces( k, j, i, & 2267 surf_def_h(0), & 2268 num_def_h(0), & 2269 num_def_h_kji(0),& 2270 .TRUE., .FALSE. ) 2271 ENDIF 2272 ENDIF 2273 ! 2274 !-- downward-facing surface, first, model top. Please note, 2275 !-- for the moment, downward-facing surfaces are always of 2276 !-- default type 2277 IF ( k == nzt .AND. use_top_fluxes ) THEN 2278 CALL initialize_top( k, j, i, surf_def_h(2), & 2279 num_def_h(2), num_def_h_kji(2) ) 2280 ! 2281 !-- Check for any other downward-facing surface. So far only for 2282 !-- default surface type. 2283 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i), 0 ) ) THEN 2284 CALL initialize_horizontal_surfaces( k, j, i, & 2285 surf_def_h(1), & 2286 num_def_h(1), & 2287 num_def_h_kji(1), & 2288 .FALSE., .TRUE. ) 2289 ENDIF 2290 ! 2291 !-- Check for vertical walls and, if required, initialize it. 2292 ! Start with northward-facing surface. 2293 IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 ) ) THEN 2294 ! 2295 !-- Determine flags indicating terrain or building 2296 terrain = BTEST( wall_flags_total_0(k,j-1,i), 5 ) .OR. & 2297 topo_no_distinct 2298 building = BTEST( wall_flags_total_0(k,j-1,i), 6 ) .OR. & 2299 topo_no_distinct 2300 2301 unresolved_building = BTEST( wall_flags_total_0(k,j-1,i), 5 ) & 2302 .AND. BTEST( wall_flags_total_0(k,j-1,i), 6 ) 2303 2304 IF ( land_surface .AND. terrain .AND. & 2305 .NOT. unresolved_building ) THEN 2306 CALL initialize_vertical_surfaces( k, j, i, & 2307 surf_lsm_v(0), & 2308 num_lsm_v(0), & 2309 num_lsm_v_kji(0), & 2310 .FALSE., .FALSE., & 2311 .FALSE., .TRUE. ) 2312 ELSEIF ( urban_surface .AND. building ) THEN 2313 CALL initialize_vertical_surfaces( k, j, i, & 2314 surf_usm_v(0), & 2315 num_usm_v(0), & 2316 num_usm_v_kji(0), & 2317 .FALSE., .FALSE., & 2318 .FALSE., .TRUE. ) 2319 ELSE 2320 CALL initialize_vertical_surfaces( k, j, i, & 2321 surf_def_v(0), & 2322 num_def_v(0), & 2323 num_def_v_kji(0), & 2324 .FALSE., .FALSE., & 2325 .FALSE., .TRUE. ) 2326 ENDIF 2327 ENDIF 2328 ! 2329 !-- southward-facing surface 2330 IF ( .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) ) THEN 2331 ! 2332 !-- Determine flags indicating terrain or building 2333 terrain = BTEST( wall_flags_total_0(k,j+1,i), 5 ) .OR. & 2334 topo_no_distinct 2335 building = BTEST( wall_flags_total_0(k,j+1,i), 6 ) .OR. & 2336 topo_no_distinct 2337 2338 unresolved_building = BTEST( wall_flags_total_0(k,j+1,i), 5 ) & 2339 .AND. BTEST( wall_flags_total_0(k,j+1,i), 6 ) 2340 2341 IF ( land_surface .AND. terrain .AND. & 2342 .NOT. unresolved_building ) THEN 2343 CALL initialize_vertical_surfaces( k, j, i, & 2344 surf_lsm_v(1), & 2345 num_lsm_v(1), & 2346 num_lsm_v_kji(1), & 2347 .FALSE., .FALSE., & 2348 .TRUE., .FALSE. ) 2349 ELSEIF ( urban_surface .AND. building ) THEN 2350 CALL initialize_vertical_surfaces( k, j, i, & 2351 surf_usm_v(1), & 2352 num_usm_v(1), & 2353 num_usm_v_kji(1), & 2354 .FALSE., .FALSE., & 2355 .TRUE., .FALSE. ) 2356 ELSE 2357 CALL initialize_vertical_surfaces( k, j, i, & 2358 surf_def_v(1), & 2359 num_def_v(1), & 2360 num_def_v_kji(1), & 2361 .FALSE., .FALSE., & 2362 .TRUE., .FALSE. ) 2363 ENDIF 2364 ENDIF 2365 ! 2366 !-- eastward-facing surface 2367 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 ) ) THEN 2368 ! 2369 !-- Determine flags indicating terrain or building 2370 terrain = BTEST( wall_flags_total_0(k,j,i-1), 5 ) .OR. & 2371 topo_no_distinct 2372 building = BTEST( wall_flags_total_0(k,j,i-1), 6 ) .OR. & 2373 topo_no_distinct 2374 2375 unresolved_building = BTEST( wall_flags_total_0(k,j,i-1), 5 ) & 2376 .AND. BTEST( wall_flags_total_0(k,j,i-1), 6 ) 2377 2378 IF ( land_surface .AND. terrain .AND. & 2379 .NOT. unresolved_building ) THEN 2380 CALL initialize_vertical_surfaces( k, j, i, & 2381 surf_lsm_v(2), & 2382 num_lsm_v(2), & 2383 num_lsm_v_kji(2), & 2384 .TRUE., .FALSE., & 2385 .FALSE., .FALSE. ) 2386 ELSEIF ( urban_surface .AND. building ) THEN 2387 CALL initialize_vertical_surfaces( k, j, i, & 2388 surf_usm_v(2), & 2389 num_usm_v(2), & 2390 num_usm_v_kji(2), & 2391 .TRUE., .FALSE., & 2392 .FALSE., .FALSE. ) 2393 ELSE 2394 CALL initialize_vertical_surfaces( k, j, i, & 2395 surf_def_v(2), & 2396 num_def_v(2), & 2397 num_def_v_kji(2), & 2398 .TRUE., .FALSE., & 2399 .FALSE., .FALSE. ) 2400 ENDIF 2401 ENDIF 2402 ! 2403 !-- westward-facing surface 2404 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) ) THEN 2405 ! 2406 !-- Determine flags indicating terrain or building 2407 terrain = BTEST( wall_flags_total_0(k,j,i+1), 5 ) .OR. & 2408 topo_no_distinct 2409 building = BTEST( wall_flags_total_0(k,j,i+1), 6 ) .OR. & 2410 topo_no_distinct 2411 2412 unresolved_building = BTEST( wall_flags_total_0(k,j,i+1), 5 ) & 2413 .AND. BTEST( wall_flags_total_0(k,j,i+1), 6 ) 2414 2415 IF ( land_surface .AND. terrain .AND. & 2416 .NOT. unresolved_building ) THEN 2417 CALL initialize_vertical_surfaces( k, j, i, & 2418 surf_lsm_v(3), & 2419 num_lsm_v(3), & 2420 num_lsm_v_kji(3), & 2421 .FALSE., .TRUE., & 2422 .FALSE., .FALSE. ) 2423 ELSEIF ( urban_surface .AND. building ) THEN 2424 CALL initialize_vertical_surfaces( k, j, i, & 2425 surf_usm_v(3), & 2426 num_usm_v(3), & 2427 num_usm_v_kji(3), & 2428 .FALSE., .TRUE., & 2429 .FALSE., .FALSE. ) 2430 ELSE 2431 CALL initialize_vertical_surfaces( k, j, i, & 2432 surf_def_v(3), & 2433 num_def_v(3), & 2434 num_def_v_kji(3), & 2435 .FALSE., .TRUE., & 2436 .FALSE., .FALSE. ) 2437 ENDIF 2263 unresolved_building = BTEST( wall_flags_total_0(k-1,j,i), 5 ) .AND. & 2264 BTEST( wall_flags_total_0(k-1,j,i), 6 ) 2265 ! 2266 !-- Natural surface type 2267 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 2268 CALL initialize_horizontal_surfaces( k, j, i, surf_lsm_h, num_lsm_h, & 2269 num_lsm_h_kji, .TRUE., .FALSE. ) 2270 ! 2271 !-- Urban surface tpye 2272 ELSEIF ( urban_surface .AND. building ) THEN 2273 CALL initialize_horizontal_surfaces( k, j, i, surf_usm_h, num_usm_h, & 2274 num_usm_h_kji, .TRUE., .FALSE. ) 2275 ! 2276 !-- Default surface type 2277 ELSE 2278 CALL initialize_horizontal_surfaces( k, j, i, surf_def_h(0), num_def_h(0), & 2279 num_def_h_kji(0), .TRUE., .FALSE. ) 2438 2280 ENDIF 2439 2281 ENDIF 2440 2441 2442 ENDDO 2443 ! 2444 !-- Determine start- and end-index at grid point (j,i). Also, for 2445 !-- horizontal surfaces more than 1 horizontal surface element can 2446 !-- exist at grid point (j,i) if overhanging structures are present. 2447 !-- Upward-facing surfaces 2448 surf_def_h(0)%start_index(j,i) = start_index_def_h(0) 2449 surf_def_h(0)%end_index(j,i) = surf_def_h(0)%start_index(j,i) + & 2450 num_def_h_kji(0) - 1 2451 start_index_def_h(0) = surf_def_h(0)%end_index(j,i) + 1 2452 ! 2453 !-- ATTENTION: 2454 !-- workaround to prevent vectorization bug on NEC Aurora 2455 IF ( start_index_def_h(0) < -99999 ) THEN 2456 PRINT*, 'i=', i, ' j=',j, ' s=',surf_def_h(0)%start_index(j,i), & 2457 ' e=', surf_def_h(0)%end_index(j,i) 2458 ENDIF 2459 ! 2460 !-- Downward-facing surfaces, except model top 2461 surf_def_h(1)%start_index(j,i) = start_index_def_h(1) 2462 surf_def_h(1)%end_index(j,i) = surf_def_h(1)%start_index(j,i) + & 2463 num_def_h_kji(1) - 1 2464 start_index_def_h(1) = surf_def_h(1)%end_index(j,i) + 1 2465 ! 2466 !-- Downward-facing surfaces -- model top fluxes 2467 surf_def_h(2)%start_index(j,i) = start_index_def_h(2) 2468 surf_def_h(2)%end_index(j,i) = surf_def_h(2)%start_index(j,i) + & 2469 num_def_h_kji(2) - 1 2470 start_index_def_h(2) = surf_def_h(2)%end_index(j,i) + 1 2471 ! 2472 !-- Horizontal natural land surfaces 2473 surf_lsm_h%start_index(j,i) = start_index_lsm_h 2474 surf_lsm_h%end_index(j,i) = surf_lsm_h%start_index(j,i) + & 2475 num_lsm_h_kji - 1 2476 start_index_lsm_h = surf_lsm_h%end_index(j,i) + 1 2477 ! 2478 !-- Horizontal urban surfaces 2479 surf_usm_h%start_index(j,i) = start_index_usm_h 2480 surf_usm_h%end_index(j,i) = surf_usm_h%start_index(j,i) + & 2481 num_usm_h_kji - 1 2482 start_index_usm_h = surf_usm_h%end_index(j,i) + 1 2483 2484 ! 2485 !-- Vertical surfaces - Default type 2486 surf_def_v(0)%start_index(j,i) = start_index_def_v(0) 2487 surf_def_v(1)%start_index(j,i) = start_index_def_v(1) 2488 surf_def_v(2)%start_index(j,i) = start_index_def_v(2) 2489 surf_def_v(3)%start_index(j,i) = start_index_def_v(3) 2490 surf_def_v(0)%end_index(j,i) = start_index_def_v(0) + & 2491 num_def_v_kji(0) - 1 2492 surf_def_v(1)%end_index(j,i) = start_index_def_v(1) + & 2493 num_def_v_kji(1) - 1 2494 surf_def_v(2)%end_index(j,i) = start_index_def_v(2) + & 2495 num_def_v_kji(2) - 1 2496 surf_def_v(3)%end_index(j,i) = start_index_def_v(3) + & 2497 num_def_v_kji(3) - 1 2498 start_index_def_v(0) = surf_def_v(0)%end_index(j,i) + 1 2499 start_index_def_v(1) = surf_def_v(1)%end_index(j,i) + 1 2500 start_index_def_v(2) = surf_def_v(2)%end_index(j,i) + 1 2501 start_index_def_v(3) = surf_def_v(3)%end_index(j,i) + 1 2502 ! 2503 !-- Natural type 2504 surf_lsm_v(0)%start_index(j,i) = start_index_lsm_v(0) 2505 surf_lsm_v(1)%start_index(j,i) = start_index_lsm_v(1) 2506 surf_lsm_v(2)%start_index(j,i) = start_index_lsm_v(2) 2507 surf_lsm_v(3)%start_index(j,i) = start_index_lsm_v(3) 2508 surf_lsm_v(0)%end_index(j,i) = start_index_lsm_v(0) + & 2509 num_lsm_v_kji(0) - 1 2510 surf_lsm_v(1)%end_index(j,i) = start_index_lsm_v(1) + & 2511 num_lsm_v_kji(1) - 1 2512 surf_lsm_v(2)%end_index(j,i) = start_index_lsm_v(2) + & 2513 num_lsm_v_kji(2) - 1 2514 surf_lsm_v(3)%end_index(j,i) = start_index_lsm_v(3) + & 2515 num_lsm_v_kji(3) - 1 2516 start_index_lsm_v(0) = surf_lsm_v(0)%end_index(j,i) + 1 2517 start_index_lsm_v(1) = surf_lsm_v(1)%end_index(j,i) + 1 2518 start_index_lsm_v(2) = surf_lsm_v(2)%end_index(j,i) + 1 2519 start_index_lsm_v(3) = surf_lsm_v(3)%end_index(j,i) + 1 2520 ! 2521 !-- Urban type 2522 surf_usm_v(0)%start_index(j,i) = start_index_usm_v(0) 2523 surf_usm_v(1)%start_index(j,i) = start_index_usm_v(1) 2524 surf_usm_v(2)%start_index(j,i) = start_index_usm_v(2) 2525 surf_usm_v(3)%start_index(j,i) = start_index_usm_v(3) 2526 surf_usm_v(0)%end_index(j,i) = start_index_usm_v(0) + & 2527 num_usm_v_kji(0) - 1 2528 surf_usm_v(1)%end_index(j,i) = start_index_usm_v(1) + & 2529 num_usm_v_kji(1) - 1 2530 surf_usm_v(2)%end_index(j,i) = start_index_usm_v(2) + & 2531 num_usm_v_kji(2) - 1 2532 surf_usm_v(3)%end_index(j,i) = start_index_usm_v(3) + & 2533 num_usm_v_kji(3) - 1 2534 start_index_usm_v(0) = surf_usm_v(0)%end_index(j,i) + 1 2535 start_index_usm_v(1) = surf_usm_v(1)%end_index(j,i) + 1 2536 start_index_usm_v(2) = surf_usm_v(2)%end_index(j,i) + 1 2537 start_index_usm_v(3) = surf_usm_v(3)%end_index(j,i) + 1 2538 2539 2540 ENDDO 2541 ENDDO 2542 2543 CONTAINS 2544 2545 !------------------------------------------------------------------------------! 2546 ! Description: 2547 ! ------------ 2548 !> Initialize horizontal surface elements, upward- and downward-facing. 2549 !> Note, horizontal surface type alsw comprises model-top fluxes, which are, 2550 !> initialized in a different routine. 2551 !------------------------------------------------------------------------------! 2552 SUBROUTINE initialize_horizontal_surfaces( k, j, i, surf, num_h, & 2553 num_h_kji, upward_facing, & 2554 downward_facing ) 2555 2556 IMPLICIT NONE 2557 2558 INTEGER(iwp) :: i !< running index x-direction 2559 INTEGER(iwp) :: j !< running index y-direction 2560 INTEGER(iwp) :: k !< running index z-direction 2561 INTEGER(iwp) :: num_h !< current number of surface element 2562 INTEGER(iwp) :: num_h_kji !< dummy increment 2563 INTEGER(iwp) :: lsp !< running index chemical species 2564 INTEGER(iwp) :: lsp_pr !< running index chemical species?? 2565 2566 LOGICAL :: upward_facing !< flag indicating upward-facing surface 2567 LOGICAL :: downward_facing !< flag indicating downward-facing surface 2568 2569 TYPE( surf_type ) :: surf !< respective surface type 2570 2571 ! 2572 !-- Store indices of respective surface element 2573 surf%i(num_h) = i 2574 surf%j(num_h) = j 2575 surf%k(num_h) = k 2576 ! 2577 !-- Surface orientation, bit 0 is set to 1 for upward-facing surfaces, 2578 !-- bit 1 is for downward-facing surfaces. 2579 IF ( upward_facing ) surf%facing(num_h) = IBSET( surf%facing(num_h), 0 ) 2580 IF ( downward_facing ) surf%facing(num_h) = IBSET( surf%facing(num_h), 1 ) 2581 ! 2582 !-- Initialize surface-layer height 2583 IF ( upward_facing ) THEN 2584 surf%z_mo(num_h) = zu(k) - zw(k-1) 2585 ELSE 2586 surf%z_mo(num_h) = zw(k) - zu(k) 2587 ENDIF 2588 2589 surf%z0(num_h) = roughness_length 2590 surf%z0h(num_h) = z0h_factor * roughness_length 2591 surf%z0q(num_h) = z0h_factor * roughness_length 2592 ! 2593 !-- Initialization in case of 1D pre-cursor run 2594 IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )& 2595 THEN 2596 IF ( .NOT. constant_diffusion ) THEN 2597 IF ( constant_flux_layer ) THEN 2598 surf%ol(num_h) = surf%z_mo(num_h) / & 2599 ( rif1d(nzb+1) + 1.0E-20_wp ) 2600 surf%us(num_h) = us1d 2601 surf%usws(num_h) = usws1d 2602 surf%vsws(num_h) = vsws1d 2282 ! 2283 !-- Downward-facing surface, first, model top. Please note, for the moment, 2284 !-- downward-facing surfaces are always of default type 2285 IF ( k == nzt .AND. use_top_fluxes ) THEN 2286 CALL initialize_top( k, j, i, surf_def_h(2), num_def_h(2), num_def_h_kji(2) ) 2287 ! 2288 !-- Check for any other downward-facing surface. So far only for default surface type. 2289 ELSEIF ( .NOT. BTEST( wall_flags_total_0(k+1,j,i), 0 ) ) THEN 2290 CALL initialize_horizontal_surfaces( k, j, i, surf_def_h(1), num_def_h(1), & 2291 num_def_h_kji(1), .FALSE., .TRUE. ) 2292 ENDIF 2293 ! 2294 !-- Check for vertical walls and, if required, initialize it. 2295 ! Start with northward-facing surface. 2296 IF ( .NOT. BTEST( wall_flags_total_0(k,j-1,i), 0 ) ) THEN 2297 ! 2298 !-- Determine flags indicating terrain or building 2299 terrain = BTEST( wall_flags_total_0(k,j-1,i), 5 ) .OR. topo_no_distinct 2300 building = BTEST( wall_flags_total_0(k,j-1,i), 6 ) .OR. topo_no_distinct 2301 2302 unresolved_building = BTEST( wall_flags_total_0(k,j-1,i), 5 ) .AND. & 2303 BTEST( wall_flags_total_0(k,j-1,i), 6 ) 2304 2305 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 2306 CALL initialize_vertical_surfaces( k, j, i, surf_lsm_v(0), num_lsm_v(0), & 2307 num_lsm_v_kji(0), .FALSE., .FALSE., & 2308 .FALSE., .TRUE. ) 2309 2310 ELSEIF ( urban_surface .AND. building ) THEN 2311 CALL initialize_vertical_surfaces( k, j, i, surf_usm_v(0), num_usm_v(0), & 2312 num_usm_v_kji(0), .FALSE., .FALSE., & 2313 .FALSE., .TRUE. ) 2603 2314 ELSE 2604 surf%ol(num_h) = surf%z_mo(num_h) / zeta_min 2605 surf%us(num_h) = 0.0_wp 2606 surf%usws(num_h) = 0.0_wp 2607 surf%vsws(num_h) = 0.0_wp 2608 ENDIF 2609 ELSE 2610 surf%ol(num_h) = surf%z_mo(num_h) / zeta_min 2611 surf%us(num_h) = 0.0_wp 2612 surf%usws(num_h) = 0.0_wp 2613 surf%vsws(num_h) = 0.0_wp 2614 ENDIF 2615 ! 2616 !-- Initialization in all other cases 2617 ELSE 2618 2619 surf%ol(num_h) = surf%z_mo(num_h) / zeta_min 2620 ! 2621 !-- Very small number is required for calculation of Obukhov length 2622 !-- at first timestep 2623 surf%us(num_h) = 1E-30_wp 2624 surf%usws(num_h) = 0.0_wp 2625 surf%vsws(num_h) = 0.0_wp 2626 2627 ENDIF 2628 2629 surf%rib(num_h) = 0.0_wp 2630 surf%uvw_abs(num_h) = 0.0_wp 2631 2632 IF ( .NOT. constant_diffusion ) THEN 2633 surf%u_0(num_h) = 0.0_wp 2634 surf%v_0(num_h) = 0.0_wp 2635 ENDIF 2636 2637 surf%ts(num_h) = 0.0_wp 2638 ! 2639 !-- Set initial value for surface temperature 2640 surf%pt_surface(num_h) = pt_surface 2641 2642 IF ( humidity ) THEN 2643 surf%qs(num_h) = 0.0_wp 2644 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 2645 surf%qcs(num_h) = 0.0_wp 2646 surf%ncs(num_h) = 0.0_wp 2647 2648 surf%qcsws(num_h) = 0.0_wp 2649 surf%ncsws(num_h) = 0.0_wp 2650 2651 ENDIF 2652 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 2653 surf%qrs(num_h) = 0.0_wp 2654 surf%nrs(num_h) = 0.0_wp 2655 2656 surf%qrsws(num_h) = 0.0_wp 2657 surf%nrsws(num_h) = 0.0_wp 2658 2659 surf%pt1(num_h) = 0.0_wp 2660 surf%qv1(num_h) = 0.0_wp 2661 surf%vpt1(num_h) = 0.0_wp 2662 2663 ENDIF 2664 2665 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 2666 surf%qis(num_h) = 0.0_wp 2667 surf%nis(num_h) = 0.0_wp 2668 2669 surf%qisws(num_h) = 0.0_wp 2670 surf%nisws(num_h) = 0.0_wp 2671 ENDIF 2672 2673 2674 surf%q_surface(num_h) = q_surface 2675 surf%vpt_surface(num_h) = surf%pt_surface(num_h) * & 2676 ( 1.0_wp + 0.61_wp * surf%q_surface(num_h) ) 2677 ENDIF 2678 2679 IF ( passive_scalar ) surf%ss(num_h) = 0.0_wp 2680 2681 DO lsp = 1, nvar 2682 IF ( air_chemistry ) surf%css(lsp,num_h) = 0.0_wp 2683 ! 2684 !-- Ensure that fluxes of compounds which are not specified in 2685 !-- namelist are all zero --> kanani: revise 2686 IF ( air_chemistry ) surf%cssws(lsp,num_h) = 0.0_wp 2687 ENDDO 2688 ! 2689 !-- Inititalize surface fluxes of sensible and latent heat, as well as 2690 !-- passive scalar 2691 IF ( use_surface_fluxes ) THEN 2692 2693 IF ( upward_facing ) THEN 2694 IF ( constant_heatflux ) THEN 2695 ! 2696 !-- Initialize surface heatflux. However, skip this for now if 2697 !-- if random_heatflux is set. This case, shf is initialized later. 2698 IF ( .NOT. random_heatflux ) THEN 2699 surf%shf(num_h) = surface_heatflux * & 2700 heatflux_input_conversion(k-1) 2701 ! 2702 !-- Check if surface heat flux might be replaced by 2703 !-- prescribed wall heatflux 2704 IF ( k-1 /= 0 ) THEN 2705 surf%shf(num_h) = wall_heatflux(0) * & 2706 heatflux_input_conversion(k-1) 2707 ENDIF 2708 ENDIF 2709 ELSE 2710 surf%shf(num_h) = 0.0_wp 2711 ENDIF 2712 ! 2713 !-- Set heat-flux at downward-facing surfaces 2714 ELSE 2715 surf%shf(num_h) = wall_heatflux(5) * & 2716 heatflux_input_conversion(k) 2717 ENDIF 2718 2719 IF ( humidity ) THEN 2720 IF ( upward_facing ) THEN 2721 IF ( constant_waterflux ) THEN 2722 surf%qsws(num_h) = surface_waterflux * & 2723 waterflux_input_conversion(k-1) 2724 IF ( k-1 /= 0 ) THEN 2725 surf%qsws(num_h) = wall_humidityflux(0) * & 2726 waterflux_input_conversion(k-1) 2727 ENDIF 2728 ELSE 2729 surf%qsws(num_h) = 0.0_wp 2730 ENDIF 2731 ELSE 2732 surf%qsws(num_h) = wall_humidityflux(5) * & 2733 waterflux_input_conversion(k) 2315 CALL initialize_vertical_surfaces( k, j, i, surf_def_v(0), num_def_v(0), & 2316 num_def_v_kji(0), .FALSE., .FALSE., & 2317 .FALSE., .TRUE. ) 2734 2318 ENDIF 2735 2319 ENDIF 2736 2737 IF ( passive_scalar ) THEN 2738 IF ( upward_facing ) THEN 2739 IF ( constant_scalarflux ) THEN 2740 surf%ssws(num_h) = surface_scalarflux * rho_air_zw(k-1) 2741 2742 IF ( k-1 /= 0 ) & 2743 surf%ssws(num_h) = wall_scalarflux(0) * & 2744 rho_air_zw(k-1) 2745 2746 ELSE 2747 surf%ssws(num_h) = 0.0_wp 2748 ENDIF 2320 ! 2321 !-- Southward-facing surface 2322 IF ( .NOT. BTEST( wall_flags_total_0(k,j+1,i), 0 ) ) THEN 2323 ! 2324 !-- Determine flags indicating terrain or building 2325 terrain = BTEST( wall_flags_total_0(k,j+1,i), 5 ) .OR. topo_no_distinct 2326 building = BTEST( wall_flags_total_0(k,j+1,i), 6 ) .OR. topo_no_distinct 2327 2328 unresolved_building = BTEST( wall_flags_total_0(k,j+1,i), 5 ) .AND. & 2329 BTEST( wall_flags_total_0(k,j+1,i), 6 ) 2330 2331 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 2332 CALL initialize_vertical_surfaces( k, j, i, surf_lsm_v(1), num_lsm_v(1), & 2333 num_lsm_v_kji(1), .FALSE., .FALSE., & 2334 .TRUE., .FALSE. ) 2335 2336 ELSEIF ( urban_surface .AND. building ) THEN 2337 CALL initialize_vertical_surfaces( k, j, i, surf_usm_v(1), num_usm_v(1), & 2338 num_usm_v_kji(1), .FALSE., .FALSE., & 2339 .TRUE., .FALSE. ) 2749 2340 ELSE 2750 surf%ssws(num_h) = wall_scalarflux(5) * rho_air_zw(k) 2341 CALL initialize_vertical_surfaces( k, j, i, surf_def_v(1), num_def_v(1), & 2342 num_def_v_kji(1), .FALSE., .FALSE., & 2343 .TRUE., .FALSE. ) 2751 2344 ENDIF 2752 2345 ENDIF 2753 2754 IF ( air_chemistry ) THEN 2755 lsp_pr = 1 2756 DO WHILE ( TRIM( surface_csflux_name( lsp_pr ) ) /= 'novalue' ) !<'novalue' is the default 2757 DO lsp = 1, nvar 2758 ! 2759 !-- Assign surface flux for each variable species 2760 IF ( TRIM( spc_names(lsp) ) == TRIM( surface_csflux_name(lsp_pr) ) ) THEN 2761 IF ( upward_facing ) THEN 2762 IF ( constant_csflux(lsp_pr) ) THEN 2763 surf%cssws(lsp,num_h) = & 2764 surface_csflux(lsp_pr) *& 2765 rho_air_zw(k-1) 2766 2767 IF ( k-1 /= 0 ) & 2768 surf%cssws(lsp,num_h) = & 2769 wall_csflux(lsp,0) * & 2770 rho_air_zw(k-1) 2771 ELSE 2772 surf%cssws(lsp,num_h) = 0.0_wp 2773 ENDIF 2774 ELSE 2775 surf%cssws(lsp,num_h) = wall_csflux(lsp,5) * & 2776 rho_air_zw(k) 2777 ENDIF 2778 ENDIF 2779 ENDDO 2780 lsp_pr = lsp_pr + 1 2781 ENDDO 2346 ! 2347 !-- Eastward-facing surface 2348 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i-1), 0 ) ) THEN 2349 ! 2350 !-- Determine flags indicating terrain or building 2351 terrain = BTEST( wall_flags_total_0(k,j,i-1), 5 ) .OR. topo_no_distinct 2352 building = BTEST( wall_flags_total_0(k,j,i-1), 6 ) .OR. topo_no_distinct 2353 2354 unresolved_building = BTEST( wall_flags_total_0(k,j,i-1), 5 ) .AND. & 2355 BTEST( wall_flags_total_0(k,j,i-1), 6 ) 2356 2357 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 2358 CALL initialize_vertical_surfaces( k, j, i, surf_lsm_v(2), num_lsm_v(2), & 2359 num_lsm_v_kji(2), .TRUE., .FALSE., & 2360 .FALSE., .FALSE. ) 2361 2362 ELSEIF ( urban_surface .AND. building ) THEN 2363 CALL initialize_vertical_surfaces( k, j, i, surf_usm_v(2), num_usm_v(2), & 2364 num_usm_v_kji(2), .TRUE., .FALSE., & 2365 .FALSE., .FALSE. ) 2366 ELSE 2367 CALL initialize_vertical_surfaces( k, j, i, surf_def_v(2), num_def_v(2), & 2368 num_def_v_kji(2), .TRUE., .FALSE., & 2369 .FALSE., .FALSE. ) 2370 ENDIF 2782 2371 ENDIF 2783 2784 IF ( ocean_mode ) THEN 2785 IF ( upward_facing ) THEN 2786 surf%sasws(num_h) = bottom_salinityflux * rho_air_zw(k-1) 2372 ! 2373 !-- Westward-facing surface 2374 IF ( .NOT. BTEST( wall_flags_total_0(k,j,i+1), 0 ) ) THEN 2375 ! 2376 !-- Determine flags indicating terrain or building 2377 terrain = BTEST( wall_flags_total_0(k,j,i+1), 5 ) .OR. topo_no_distinct 2378 building = BTEST( wall_flags_total_0(k,j,i+1), 6 ) .OR. topo_no_distinct 2379 2380 unresolved_building = BTEST( wall_flags_total_0(k,j,i+1), 5 ) .AND. & 2381 BTEST( wall_flags_total_0(k,j,i+1), 6 ) 2382 2383 IF ( land_surface .AND. terrain .AND. .NOT. unresolved_building ) THEN 2384 CALL initialize_vertical_surfaces( k, j, i, surf_lsm_v(3), num_lsm_v(3), & 2385 num_lsm_v_kji(3), .FALSE., .TRUE., & 2386 .FALSE., .FALSE. ) 2387 2388 ELSEIF ( urban_surface .AND. building ) THEN 2389 CALL initialize_vertical_surfaces( k, j, i, surf_usm_v(3), num_usm_v(3), & 2390 num_usm_v_kji(3), .FALSE., .TRUE., & 2391 .FALSE., .FALSE. ) 2787 2392 ELSE 2788 surf%sasws(num_h) = 0.0_wp 2393 CALL initialize_vertical_surfaces( k, j, i, surf_def_v(3), num_def_v(3), & 2394 num_def_v_kji(3), .FALSE., .TRUE., & 2395 .FALSE., .FALSE. ) 2789 2396 ENDIF 2790 2397 ENDIF 2791 2398 ENDIF 2792 ! 2793 !-- Increment surface indices 2794 num_h = num_h + 1 2795 num_h_kji = num_h_kji + 1 2796 2797 2798 END SUBROUTINE initialize_horizontal_surfaces 2799 2800 2801 !------------------------------------------------------------------------------! 2399 2400 2401 ENDDO 2402 ! 2403 !-- Determine start- and end-index at grid point (j,i). Also, for horizontal surfaces more 2404 !-- than 1 horizontal surface element can exist at grid point (j,i) if overhanging structures 2405 !-- are present. 2406 !-- Upward-facing surfaces 2407 surf_def_h(0)%start_index(j,i) = start_index_def_h(0) 2408 surf_def_h(0)%end_index(j,i) = surf_def_h(0)%start_index(j,i) + num_def_h_kji(0) - 1 2409 start_index_def_h(0) = surf_def_h(0)%end_index(j,i) + 1 2410 ! 2411 !-- ATTENTION: 2412 !-- Workaround to prevent vectorization bug on NEC Aurora 2413 IF ( start_index_def_h(0) < -99999 ) THEN 2414 PRINT*, 'i=', i, ' j=',j, ' s=',surf_def_h(0)%start_index(j,i), & 2415 ' e=', surf_def_h(0)%end_index(j,i) 2416 ENDIF 2417 ! 2418 !-- Downward-facing surfaces, except model top 2419 surf_def_h(1)%start_index(j,i) = start_index_def_h(1) 2420 surf_def_h(1)%end_index(j,i) = surf_def_h(1)%start_index(j,i) + num_def_h_kji(1) - 1 2421 start_index_def_h(1) = surf_def_h(1)%end_index(j,i) + 1 2422 ! 2423 !-- Downward-facing surfaces -- model top fluxes 2424 surf_def_h(2)%start_index(j,i) = start_index_def_h(2) 2425 surf_def_h(2)%end_index(j,i) = surf_def_h(2)%start_index(j,i) + num_def_h_kji(2) - 1 2426 start_index_def_h(2) = surf_def_h(2)%end_index(j,i) + 1 2427 ! 2428 !-- Horizontal natural land surfaces 2429 surf_lsm_h%start_index(j,i) = start_index_lsm_h 2430 surf_lsm_h%end_index(j,i) = surf_lsm_h%start_index(j,i) + num_lsm_h_kji - 1 2431 start_index_lsm_h = surf_lsm_h%end_index(j,i) + 1 2432 ! 2433 !-- Horizontal urban surfaces 2434 surf_usm_h%start_index(j,i) = start_index_usm_h 2435 surf_usm_h%end_index(j,i) = surf_usm_h%start_index(j,i) + num_usm_h_kji - 1 2436 start_index_usm_h = surf_usm_h%end_index(j,i) + 1 2437 2438 ! 2439 !-- Vertical surfaces - Default type 2440 surf_def_v(0)%start_index(j,i) = start_index_def_v(0) 2441 surf_def_v(1)%start_index(j,i) = start_index_def_v(1) 2442 surf_def_v(2)%start_index(j,i) = start_index_def_v(2) 2443 surf_def_v(3)%start_index(j,i) = start_index_def_v(3) 2444 surf_def_v(0)%end_index(j,i) = start_index_def_v(0) + num_def_v_kji(0) - 1 2445 surf_def_v(1)%end_index(j,i) = start_index_def_v(1) + num_def_v_kji(1) - 1 2446 surf_def_v(2)%end_index(j,i) = start_index_def_v(2) + num_def_v_kji(2) - 1 2447 surf_def_v(3)%end_index(j,i) = start_index_def_v(3) + num_def_v_kji(3) - 1 2448 start_index_def_v(0) = surf_def_v(0)%end_index(j,i) + 1 2449 start_index_def_v(1) = surf_def_v(1)%end_index(j,i) + 1 2450 start_index_def_v(2) = surf_def_v(2)%end_index(j,i) + 1 2451 start_index_def_v(3) = surf_def_v(3)%end_index(j,i) + 1 2452 ! 2453 !-- Natural type 2454 surf_lsm_v(0)%start_index(j,i) = start_index_lsm_v(0) 2455 surf_lsm_v(1)%start_index(j,i) = start_index_lsm_v(1) 2456 surf_lsm_v(2)%start_index(j,i) = start_index_lsm_v(2) 2457 surf_lsm_v(3)%start_index(j,i) = start_index_lsm_v(3) 2458 surf_lsm_v(0)%end_index(j,i) = start_index_lsm_v(0) + num_lsm_v_kji(0) - 1 2459 surf_lsm_v(1)%end_index(j,i) = start_index_lsm_v(1) + num_lsm_v_kji(1) - 1 2460 surf_lsm_v(2)%end_index(j,i) = start_index_lsm_v(2) + num_lsm_v_kji(2) - 1 2461 surf_lsm_v(3)%end_index(j,i) = start_index_lsm_v(3) + num_lsm_v_kji(3) - 1 2462 start_index_lsm_v(0) = surf_lsm_v(0)%end_index(j,i) + 1 2463 start_index_lsm_v(1) = surf_lsm_v(1)%end_index(j,i) + 1 2464 start_index_lsm_v(2) = surf_lsm_v(2)%end_index(j,i) + 1 2465 start_index_lsm_v(3) = surf_lsm_v(3)%end_index(j,i) + 1 2466 ! 2467 !-- Urban type 2468 surf_usm_v(0)%start_index(j,i) = start_index_usm_v(0) 2469 surf_usm_v(1)%start_index(j,i) = start_index_usm_v(1) 2470 surf_usm_v(2)%start_index(j,i) = start_index_usm_v(2) 2471 surf_usm_v(3)%start_index(j,i) = start_index_usm_v(3) 2472 surf_usm_v(0)%end_index(j,i) = start_index_usm_v(0) + num_usm_v_kji(0) - 1 2473 surf_usm_v(1)%end_index(j,i) = start_index_usm_v(1) + num_usm_v_kji(1) - 1 2474 surf_usm_v(2)%end_index(j,i) = start_index_usm_v(2) + num_usm_v_kji(2) - 1 2475 surf_usm_v(3)%end_index(j,i) = start_index_usm_v(3) + num_usm_v_kji(3) - 1 2476 start_index_usm_v(0) = surf_usm_v(0)%end_index(j,i) + 1 2477 start_index_usm_v(1) = surf_usm_v(1)%end_index(j,i) + 1 2478 start_index_usm_v(2) = surf_usm_v(2)%end_index(j,i) + 1 2479 start_index_usm_v(3) = surf_usm_v(3)%end_index(j,i) + 1 2480 2481 2482 ENDDO 2483 ENDDO 2484 2485 CONTAINS 2486 2487 !--------------------------------------------------------------------------------------------------! 2802 2488 ! Description: 2803 2489 ! ------------ 2804 !> Initialize model-top fluxes. Currently, only the heatflux and salinity flux 2805 !> can be prescribed, latent flux is zero in this case! 2806 !------------------------------------------------------------------------------! 2807 SUBROUTINE initialize_top( k, j, i, surf, num_h, num_h_kji ) 2808 2809 IMPLICIT NONE 2810 2811 INTEGER(iwp) :: i !< running index x-direction 2812 INTEGER(iwp) :: j !< running index y-direction 2813 INTEGER(iwp) :: k !< running index z-direction 2814 INTEGER(iwp) :: num_h !< current number of surface element 2815 INTEGER(iwp) :: num_h_kji !< dummy increment 2816 INTEGER(iwp) :: lsp !< running index for chemical species 2817 2818 TYPE( surf_type ) :: surf !< respective surface type 2819 ! 2820 !-- Store indices of respective surface element 2821 surf%i(num_h) = i 2822 surf%j(num_h) = j 2823 surf%k(num_h) = k 2824 ! 2825 !-- Initialize top heat flux 2826 IF ( constant_top_heatflux ) & 2827 surf%shf(num_h) = top_heatflux * heatflux_input_conversion(nzt+1) 2828 ! 2829 !-- Initialization in case of a coupled model run 2830 IF ( coupling_mode == 'ocean_to_atmosphere' ) THEN 2831 surf%shf(num_h) = 0.0_wp 2490 !> Initialize horizontal surface elements, upward- and downward-facing. Note, horizontal surface 2491 !> type also comprises model-top fluxes, which are, initialized in a different routine. 2492 !--------------------------------------------------------------------------------------------------! 2493 SUBROUTINE initialize_horizontal_surfaces( k, j, i, surf, num_h, num_h_kji, upward_facing, & 2494 downward_facing ) 2495 2496 IMPLICIT NONE 2497 2498 INTEGER(iwp) :: i !< running index x-direction 2499 INTEGER(iwp) :: j !< running index y-direction 2500 INTEGER(iwp) :: k !< running index z-direction 2501 INTEGER(iwp) :: num_h !< current number of surface element 2502 INTEGER(iwp) :: num_h_kji !< dummy increment 2503 INTEGER(iwp) :: lsp !< running index chemical species 2504 INTEGER(iwp) :: lsp_pr !< running index chemical species?? 2505 2506 LOGICAL :: upward_facing !< flag indicating upward-facing surface 2507 LOGICAL :: downward_facing !< flag indicating downward-facing surface 2508 2509 TYPE(surf_type) :: surf !< respective surface type 2510 2511 ! 2512 !-- Store indices of respective surface element 2513 surf%i(num_h) = i 2514 surf%j(num_h) = j 2515 surf%k(num_h) = k 2516 ! 2517 !-- Surface orientation, bit 0 is set to 1 for upward-facing surfaces, bit 1 is for downward-facing 2518 !-- surfaces. 2519 IF ( upward_facing ) surf%facing(num_h) = IBSET( surf%facing(num_h), 0 ) 2520 IF ( downward_facing ) surf%facing(num_h) = IBSET( surf%facing(num_h), 1 ) 2521 ! 2522 !-- Initialize surface-layer height 2523 IF ( upward_facing ) THEN 2524 surf%z_mo(num_h) = zu(k) - zw(k-1) 2525 ELSE 2526 surf%z_mo(num_h) = zw(k) - zu(k) 2527 ENDIF 2528 2529 surf%z0(num_h) = roughness_length 2530 surf%z0h(num_h) = z0h_factor * roughness_length 2531 surf%z0q(num_h) = z0h_factor * roughness_length 2532 ! 2533 !-- Initialization in case of 1D pre-cursor run 2534 IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 ) THEN 2535 IF ( .NOT. constant_diffusion ) THEN 2536 IF ( constant_flux_layer ) THEN 2537 surf%ol(num_h) = surf%z_mo(num_h) / ( rif1d(nzb+1) + 1.0E-20_wp ) 2538 surf%us(num_h) = us1d 2539 surf%usws(num_h) = usws1d 2540 surf%vsws(num_h) = vsws1d 2541 ELSE 2542 surf%ol(num_h) = surf%z_mo(num_h) / zeta_min 2543 surf%us(num_h) = 0.0_wp 2544 surf%usws(num_h) = 0.0_wp 2545 surf%vsws(num_h) = 0.0_wp 2546 ENDIF 2547 ELSE 2548 surf%ol(num_h) = surf%z_mo(num_h) / zeta_min 2549 surf%us(num_h) = 0.0_wp 2550 surf%usws(num_h) = 0.0_wp 2551 surf%vsws(num_h) = 0.0_wp 2552 ENDIF 2553 ! 2554 !-- Initialization in all other cases 2555 ELSE 2556 2557 surf%ol(num_h) = surf%z_mo(num_h) / zeta_min 2558 ! 2559 !-- Very small number is required for calculation of Obukhov length at first timestep 2560 surf%us(num_h) = 1E-30_wp 2561 surf%usws(num_h) = 0.0_wp 2562 surf%vsws(num_h) = 0.0_wp 2563 2564 ENDIF 2565 2566 surf%rib(num_h) = 0.0_wp 2567 surf%uvw_abs(num_h) = 0.0_wp 2568 2569 IF ( .NOT. constant_diffusion ) THEN 2570 surf%u_0(num_h) = 0.0_wp 2571 surf%v_0(num_h) = 0.0_wp 2572 ENDIF 2573 2574 surf%ts(num_h) = 0.0_wp 2575 ! 2576 !-- Set initial value for surface temperature 2577 surf%pt_surface(num_h) = pt_surface 2578 2579 IF ( humidity ) THEN 2580 surf%qs(num_h) = 0.0_wp 2581 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 2582 surf%qcs(num_h) = 0.0_wp 2583 surf%ncs(num_h) = 0.0_wp 2584 2585 surf%qcsws(num_h) = 0.0_wp 2586 surf%ncsws(num_h) = 0.0_wp 2587 2588 ENDIF 2589 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 2590 surf%qrs(num_h) = 0.0_wp 2591 surf%nrs(num_h) = 0.0_wp 2592 2593 surf%qrsws(num_h) = 0.0_wp 2594 surf%nrsws(num_h) = 0.0_wp 2595 2596 surf%pt1(num_h) = 0.0_wp 2597 surf%qv1(num_h) = 0.0_wp 2598 surf%vpt1(num_h) = 0.0_wp 2599 2600 ENDIF 2601 2602 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 2603 surf%qis(num_h) = 0.0_wp 2604 surf%nis(num_h) = 0.0_wp 2605 2606 surf%qisws(num_h) = 0.0_wp 2607 surf%nisws(num_h) = 0.0_wp 2608 ENDIF 2609 2610 2611 surf%q_surface(num_h) = q_surface 2612 surf%vpt_surface(num_h) = surf%pt_surface(num_h) * & 2613 ( 1.0_wp + 0.61_wp * surf%q_surface(num_h) ) 2614 ENDIF 2615 2616 IF ( passive_scalar ) surf%ss(num_h) = 0.0_wp 2617 2618 DO lsp = 1, nvar 2619 IF ( air_chemistry ) surf%css(lsp,num_h) = 0.0_wp 2620 ! 2621 !-- Ensure that fluxes of compounds which are not specified in namelist are all zero 2622 !-- --> kanani: revise 2623 IF ( air_chemistry ) surf%cssws(lsp,num_h) = 0.0_wp 2624 ENDDO 2625 ! 2626 !-- Inititalize surface fluxes of sensible and latent heat, as well as passive scalar 2627 IF ( use_surface_fluxes ) THEN 2628 2629 IF ( upward_facing ) THEN 2630 IF ( constant_heatflux ) THEN 2631 ! 2632 !-- Initialize surface heatflux. However, skip this for now if random_heatflux is set. 2633 !-- This case, shf is initialized later. 2634 IF ( .NOT. random_heatflux ) THEN 2635 surf%shf(num_h) = surface_heatflux * heatflux_input_conversion(k-1) 2636 ! 2637 !-- Check if surface heat flux might be replaced by prescribed wall heatflux 2638 IF ( k-1 /= 0 ) THEN 2639 surf%shf(num_h) = wall_heatflux(0) * heatflux_input_conversion(k-1) 2640 ENDIF 2641 ENDIF 2642 ELSE 2643 surf%shf(num_h) = 0.0_wp 2644 ENDIF 2645 ! 2646 !-- Set heat-flux at downward-facing surfaces 2647 ELSE 2648 surf%shf(num_h) = wall_heatflux(5) * heatflux_input_conversion(k) 2649 ENDIF 2650 2651 IF ( humidity ) THEN 2652 IF ( upward_facing ) THEN 2653 IF ( constant_waterflux ) THEN 2654 surf%qsws(num_h) = surface_waterflux * waterflux_input_conversion(k-1) 2655 IF ( k-1 /= 0 ) THEN 2656 surf%qsws(num_h) = wall_humidityflux(0) * waterflux_input_conversion(k-1) 2657 ENDIF 2658 ELSE 2832 2659 surf%qsws(num_h) = 0.0_wp 2833 2660 ENDIF 2834 ! 2835 !-- Prescribe latent heat flux at the top 2836 IF ( humidity ) THEN 2837 surf%qsws(num_h) = 0.0_wp 2838 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison ) THEN 2839 surf%ncsws(num_h) = 0.0_wp 2840 surf%qcsws(num_h) = 0.0_wp 2841 ENDIF 2842 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert ) THEN 2843 surf%nrsws(num_h) = 0.0_wp 2844 surf%qrsws(num_h) = 0.0_wp 2845 ENDIF 2846 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase ) THEN 2847 surf%nisws(num_h) = 0.0_wp 2848 surf%qisws(num_h) = 0.0_wp 2849 ENDIF 2661 ELSE 2662 surf%qsws(num_h) = wall_humidityflux(5) * waterflux_input_conversion(k) 2663 ENDIF 2664 ENDIF 2665 2666 IF ( passive_scalar ) THEN 2667 IF ( upward_facing ) THEN 2668 IF ( constant_scalarflux ) THEN 2669 surf%ssws(num_h) = surface_scalarflux * rho_air_zw(k-1) 2670 2671 IF ( k-1 /= 0 ) surf%ssws(num_h) = wall_scalarflux(0) * rho_air_zw(k-1) 2672 ELSE 2673 surf%ssws(num_h) = 0.0_wp 2850 2674 ENDIF 2851 ! 2852 !-- Prescribe top scalar flux 2853 IF ( passive_scalar .AND. constant_top_scalarflux ) & 2854 surf%ssws(num_h) = top_scalarflux * rho_air_zw(nzt+1) 2855 ! 2856 !-- Prescribe top chemical species' flux 2675 ELSE 2676 surf%ssws(num_h) = wall_scalarflux(5) * rho_air_zw(k) 2677 ENDIF 2678 ENDIF 2679 2680 IF ( air_chemistry ) THEN 2681 lsp_pr = 1 2682 DO WHILE ( TRIM( surface_csflux_name( lsp_pr ) ) /= 'novalue' ) !<'novalue' is the default 2857 2683 DO lsp = 1, nvar 2858 IF ( air_chemistry .AND. constant_top_csflux(lsp) ) THEN 2859 surf%cssws(lsp,num_h) = top_csflux(lsp) * rho_air_zw(nzt+1) 2684 ! 2685 !-- Assign surface flux for each variable species 2686 IF ( TRIM( spc_names(lsp) ) == TRIM( surface_csflux_name(lsp_pr) ) ) THEN 2687 IF ( upward_facing ) THEN 2688 IF ( constant_csflux(lsp_pr) ) THEN 2689 surf%cssws(lsp,num_h) = surface_csflux(lsp_pr) * rho_air_zw(k-1) 2690 2691 IF ( k-1 /= 0 ) surf%cssws(lsp,num_h) = wall_csflux(lsp,0) * & 2692 rho_air_zw(k-1) 2693 ELSE 2694 surf%cssws(lsp,num_h) = 0.0_wp 2695 ENDIF 2696 ELSE 2697 surf%cssws(lsp,num_h) = wall_csflux(lsp,5) * rho_air_zw(k) 2698 ENDIF 2860 2699 ENDIF 2861 2700 ENDDO 2862 ! 2863 !-- Prescribe top salinity flux 2864 IF ( ocean_mode .AND. constant_top_salinityflux) & 2865 surf%sasws(num_h) = top_salinityflux * rho_air_zw(nzt+1) 2866 ! 2867 !-- Top momentum fluxes 2868 IF ( constant_top_momentumflux ) THEN 2869 surf%usws(num_h) = top_momentumflux_u * & 2870 momentumflux_input_conversion(nzt+1) 2871 surf%vsws(num_h) = top_momentumflux_v * & 2872 momentumflux_input_conversion(nzt+1) 2873 ENDIF 2874 ! 2875 !-- Increment surface indices 2876 num_h = num_h + 1 2877 num_h_kji = num_h_kji + 1 2878 2879 2880 END SUBROUTINE initialize_top 2881 2882 2883 !------------------------------------------------------------------------------! 2701 lsp_pr = lsp_pr + 1 2702 ENDDO 2703 ENDIF 2704 2705 IF ( ocean_mode ) THEN 2706 IF ( upward_facing ) THEN 2707 surf%sasws(num_h) = bottom_salinityflux * rho_air_zw(k-1) 2708 ELSE 2709 surf%sasws(num_h) = 0.0_wp 2710 ENDIF 2711 ENDIF 2712 ENDIF 2713 ! 2714 !-- Increment surface indices 2715 num_h = num_h + 1 2716 num_h_kji = num_h_kji + 1 2717 2718 2719 END SUBROUTINE initialize_horizontal_surfaces 2720 2721 2722 !--------------------------------------------------------------------------------------------------! 2723 ! Description: 2724 ! ------------ 2725 !> Initialize model-top fluxes. Currently, only the heatflux and salinity flux can be prescribed, 2726 !> latent flux is zero in this case! 2727 !--------------------------------------------------------------------------------------------------! 2728 SUBROUTINE initialize_top( k, j, i, surf, num_h, num_h_kji ) 2729 2730 IMPLICIT NONE 2731 2732 INTEGER(iwp) :: i !< running index x-direction 2733 INTEGER(iwp) :: j !< running index y-direction 2734 INTEGER(iwp) :: k !< running index z-direction 2735 INTEGER(iwp) :: num_h !< current number of surface element 2736 INTEGER(iwp) :: num_h_kji !< dummy increment 2737 INTEGER(iwp) :: lsp !< running index for chemical species 2738 2739 TYPE( surf_type ) :: surf !< respective surface type 2740 ! 2741 !-- Store indices of respective surface element 2742 surf%i(num_h) = i 2743 surf%j(num_h) = j 2744 surf%k(num_h) = k 2745 ! 2746 !-- Initialize top heat flux 2747 IF ( constant_top_heatflux ) surf%shf(num_h) = top_heatflux * heatflux_input_conversion(nzt+1) 2748 ! 2749 !-- Initialization in case of a coupled model run 2750 IF ( coupling_mode == 'ocean_to_atmosphere' ) THEN 2751 surf%shf(num_h) = 0.0_wp 2752 surf%qsws(num_h) = 0.0_wp 2753 ENDIF 2754 ! 2755 !-- Prescribe latent heat flux at the top 2756 IF ( humidity ) THEN 2757 surf%qsws(num_h) = 0.0_wp 2758 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison ) THEN 2759 surf%ncsws(num_h) = 0.0_wp 2760 surf%qcsws(num_h) = 0.0_wp 2761 ENDIF 2762 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert ) THEN 2763 surf%nrsws(num_h) = 0.0_wp 2764 surf%qrsws(num_h) = 0.0_wp 2765 ENDIF 2766 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase ) THEN 2767 surf%nisws(num_h) = 0.0_wp 2768 surf%qisws(num_h) = 0.0_wp 2769 ENDIF 2770 ENDIF 2771 ! 2772 !-- Prescribe top scalar flux 2773 IF ( passive_scalar .AND. constant_top_scalarflux ) surf%ssws(num_h) = top_scalarflux * & 2774 rho_air_zw(nzt+1) 2775 ! 2776 !-- Prescribe top chemical species' flux 2777 DO lsp = 1, nvar 2778 IF ( air_chemistry .AND. constant_top_csflux(lsp) ) THEN 2779 surf%cssws(lsp,num_h) = top_csflux(lsp) * rho_air_zw(nzt+1) 2780 ENDIF 2781 ENDDO 2782 ! 2783 !-- Prescribe top salinity flux 2784 IF ( ocean_mode .AND. constant_top_salinityflux) surf%sasws(num_h) = top_salinityflux * & 2785 rho_air_zw(nzt+1) 2786 ! 2787 !-- Top momentum fluxes 2788 IF ( constant_top_momentumflux ) THEN 2789 surf%usws(num_h) = top_momentumflux_u * momentumflux_input_conversion(nzt+1) 2790 surf%vsws(num_h) = top_momentumflux_v * momentumflux_input_conversion(nzt+1) 2791 ENDIF 2792 ! 2793 !-- Increment surface indices 2794 num_h = num_h + 1 2795 num_h_kji = num_h_kji + 1 2796 2797 2798 END SUBROUTINE initialize_top 2799 2800 2801 !--------------------------------------------------------------------------------------------------! 2884 2802 ! Description: 2885 2803 ! ------------ 2886 2804 !> Initialize vertical surface elements. 2887 !------------------------------------------------------------------------------! 2888 SUBROUTINE initialize_vertical_surfaces( k, j, i, surf, num_v, & 2889 num_v_kji, east_facing, & 2890 west_facing, south_facing, & 2891 north_facing ) 2892 2893 IMPLICIT NONE 2894 2895 INTEGER(iwp) :: component !< index of wall_fluxes_ array for respective orientation 2896 INTEGER(iwp) :: i !< running index x-direction 2897 INTEGER(iwp) :: j !< running index x-direction 2898 INTEGER(iwp) :: k !< running index x-direction 2899 INTEGER(iwp) :: num_v !< current number of surface element 2900 INTEGER(iwp) :: num_v_kji !< current number of surface element at (j,i) 2901 INTEGER(iwp) :: lsp !< running index for chemical species 2902 2903 2904 LOGICAL :: east_facing !< flag indicating east-facing surfaces 2905 LOGICAL :: north_facing !< flag indicating north-facing surfaces 2906 LOGICAL :: south_facing !< flag indicating south-facing surfaces 2907 LOGICAL :: west_facing !< flag indicating west-facing surfaces 2908 2909 TYPE( surf_type ) :: surf !< respective surface type 2910 2911 ! 2912 !-- Store indices of respective wall element 2913 surf%i(num_v) = i 2914 surf%j(num_v) = j 2915 surf%k(num_v) = k 2916 ! 2917 !-- Initialize surface-layer height, or more precisely, distance to surface 2918 IF ( north_facing .OR. south_facing ) THEN 2919 surf%z_mo(num_v) = 0.5_wp * dy 2920 ELSE 2921 surf%z_mo(num_v) = 0.5_wp * dx 2922 ENDIF 2923 2924 surf%facing(num_v) = 0 2925 ! 2926 !-- Surface orientation. Moreover, set component id to map wall_heatflux, 2927 !-- etc., on surface type (further below) 2928 IF ( north_facing ) THEN 2929 surf%facing(num_v) = 5 !IBSET( surf%facing(num_v), 0 ) 2930 component = 4 2931 ENDIF 2932 2933 IF ( south_facing ) THEN 2934 surf%facing(num_v) = 6 !IBSET( surf%facing(num_v), 1 ) 2935 component = 3 2936 ENDIF 2937 2938 IF ( east_facing ) THEN 2939 surf%facing(num_v) = 7 !IBSET( surf%facing(num_v), 2 ) 2940 component = 2 2941 ENDIF 2942 2943 IF ( west_facing ) THEN 2944 surf%facing(num_v) = 8 !IBSET( surf%facing(num_v), 3 ) 2945 component = 1 2946 ENDIF 2947 2948 2949 surf%z0(num_v) = roughness_length 2950 surf%z0h(num_v) = z0h_factor * roughness_length 2951 surf%z0q(num_v) = z0h_factor * roughness_length 2952 2953 surf%us(num_v) = 0.0_wp 2954 ! 2955 !-- If required, initialize Obukhov length 2956 IF ( ALLOCATED( surf%ol ) ) & 2957 surf%ol(num_v) = surf%z_mo(num_v) / zeta_min 2958 2959 surf%uvw_abs(num_v) = 0.0_wp 2960 2961 surf%mom_flux_uv(num_v) = 0.0_wp 2962 surf%mom_flux_w(num_v) = 0.0_wp 2963 surf%mom_flux_tke(0:1,num_v) = 0.0_wp 2964 2965 surf%ts(num_v) = 0.0_wp 2966 surf%shf(num_v) = wall_heatflux(component) 2967 ! 2968 !-- Set initial value for surface temperature 2969 surf%pt_surface(num_v) = pt_surface 2970 2971 IF ( humidity ) THEN 2972 surf%qs(num_v) = 0.0_wp 2973 surf%qsws(num_v) = wall_humidityflux(component) 2974 ! 2975 !-- Following wall fluxes are assumed to be zero 2976 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 2977 surf%qcs(num_v) = 0.0_wp 2978 surf%ncs(num_v) = 0.0_wp 2979 2980 surf%qcsws(num_v) = 0.0_wp 2981 surf%ncsws(num_v) = 0.0_wp 2982 ENDIF 2983 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 2984 surf%qrs(num_v) = 0.0_wp 2985 surf%nrs(num_v) = 0.0_wp 2986 2987 surf%qrsws(num_v) = 0.0_wp 2988 surf%nrsws(num_v) = 0.0_wp 2989 ENDIF 2990 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 2991 surf%qis(num_v) = 0.0_wp 2992 surf%nis(num_v) = 0.0_wp 2993 2994 surf%qisws(num_v) = 0.0_wp 2995 surf%nisws(num_v) = 0.0_wp 2996 ENDIF 2997 ENDIF 2998 2999 IF ( passive_scalar ) THEN 3000 surf%ss(num_v) = 0.0_wp 3001 surf%ssws(num_v) = wall_scalarflux(component) 3002 ENDIF 3003 3004 IF ( air_chemistry ) THEN 3005 DO lsp = 1, nvar 3006 surf%css(lsp,num_v) = 0.0_wp 3007 surf%cssws(lsp,num_v) = wall_csflux(lsp,component) 3008 ENDDO 3009 ENDIF 3010 3011 ! 3012 !-- So far, salinityflux at vertical surfaces is simply zero 3013 !-- at the moment 3014 IF ( ocean_mode ) surf%sasws(num_v) = wall_salinityflux(component) 3015 ! 3016 !-- Increment wall indices 3017 num_v = num_v + 1 3018 num_v_kji = num_v_kji + 1 3019 3020 END SUBROUTINE initialize_vertical_surfaces 3021 3022 END SUBROUTINE init_surfaces 3023 2805 !--------------------------------------------------------------------------------------------------! 2806 SUBROUTINE initialize_vertical_surfaces( k, j, i, surf, num_v, num_v_kji, east_facing, & 2807 west_facing, south_facing, north_facing ) 2808 2809 IMPLICIT NONE 2810 2811 INTEGER(iwp) :: component !< index of wall_fluxes_ array for respective orientation 2812 INTEGER(iwp) :: i !< running index x-direction 2813 INTEGER(iwp) :: j !< running index x-direction 2814 INTEGER(iwp) :: k !< running index x-direction 2815 INTEGER(iwp) :: num_v !< current number of surface element 2816 INTEGER(iwp) :: num_v_kji !< current number of surface element at (j,i) 2817 INTEGER(iwp) :: lsp !< running index for chemical species 2818 2819 2820 LOGICAL :: east_facing !< flag indicating east-facing surfaces 2821 LOGICAL :: north_facing !< flag indicating north-facing surfaces 2822 LOGICAL :: south_facing !< flag indicating south-facing surfaces 2823 LOGICAL :: west_facing !< flag indicating west-facing surfaces 2824 2825 TYPE( surf_type ) :: surf !< respective surface type 2826 2827 ! 2828 !-- Store indices of respective wall element 2829 surf%i(num_v) = i 2830 surf%j(num_v) = j 2831 surf%k(num_v) = k 2832 ! 2833 !-- Initialize surface-layer height, or more precisely, distance to surface 2834 IF ( north_facing .OR. south_facing ) THEN 2835 surf%z_mo(num_v) = 0.5_wp * dy 2836 ELSE 2837 surf%z_mo(num_v) = 0.5_wp * dx 2838 ENDIF 2839 2840 surf%facing(num_v) = 0 2841 ! 2842 !-- Surface orientation. Moreover, set component id to map wall_heatflux, etc., on surface type 2843 !-- (further below) 2844 IF ( north_facing ) THEN 2845 surf%facing(num_v) = 5 !IBSET( surf%facing(num_v), 0 ) 2846 component = 4 2847 ENDIF 2848 2849 IF ( south_facing ) THEN 2850 surf%facing(num_v) = 6 !IBSET( surf%facing(num_v), 1 ) 2851 component = 3 2852 ENDIF 2853 2854 IF ( east_facing ) THEN 2855 surf%facing(num_v) = 7 !IBSET( surf%facing(num_v), 2 ) 2856 component = 2 2857 ENDIF 2858 2859 IF ( west_facing ) THEN 2860 surf%facing(num_v) = 8 !IBSET( surf%facing(num_v), 3 ) 2861 component = 1 2862 ENDIF 2863 2864 2865 surf%z0(num_v) = roughness_length 2866 surf%z0h(num_v) = z0h_factor * roughness_length 2867 surf%z0q(num_v) = z0h_factor * roughness_length 2868 2869 surf%us(num_v) = 0.0_wp 2870 ! 2871 !-- If required, initialize Obukhov length 2872 IF ( ALLOCATED( surf%ol ) ) surf%ol(num_v) = surf%z_mo(num_v) / zeta_min 2873 2874 surf%uvw_abs(num_v) = 0.0_wp 2875 surf%mom_flux_uv(num_v) = 0.0_wp 2876 surf%mom_flux_w(num_v) = 0.0_wp 2877 surf%mom_flux_tke(0:1,num_v) = 0.0_wp 2878 2879 surf%ts(num_v) = 0.0_wp 2880 surf%shf(num_v) = wall_heatflux(component) 2881 ! 2882 !-- Set initial value for surface temperature 2883 surf%pt_surface(num_v) = pt_surface 2884 2885 IF ( humidity ) THEN 2886 surf%qs(num_v) = 0.0_wp 2887 surf%qsws(num_v) = wall_humidityflux(component) 2888 ! 2889 !-- Following wall fluxes are assumed to be zero 2890 IF ( surf_bulk_cloud_model .AND. surf_microphysics_morrison) THEN 2891 surf%qcs(num_v) = 0.0_wp 2892 surf%ncs(num_v) = 0.0_wp 2893 surf%qcsws(num_v) = 0.0_wp 2894 surf%ncsws(num_v) = 0.0_wp 2895 ENDIF 2896 IF ( surf_bulk_cloud_model .AND. surf_microphysics_seifert) THEN 2897 surf%qrs(num_v) = 0.0_wp 2898 surf%nrs(num_v) = 0.0_wp 2899 surf%qrsws(num_v) = 0.0_wp 2900 surf%nrsws(num_v) = 0.0_wp 2901 ENDIF 2902 IF ( surf_bulk_cloud_model .AND. surf_microphysics_ice_phase) THEN 2903 surf%qis(num_v) = 0.0_wp 2904 surf%nis(num_v) = 0.0_wp 2905 surf%qisws(num_v) = 0.0_wp 2906 surf%nisws(num_v) = 0.0_wp 2907 ENDIF 2908 ENDIF 2909 2910 IF ( passive_scalar ) THEN 2911 surf%ss(num_v) = 0.0_wp 2912 surf%ssws(num_v) = wall_scalarflux(component) 2913 ENDIF 2914 2915 IF ( air_chemistry ) THEN 2916 DO lsp = 1, nvar 2917 surf%css(lsp,num_v) = 0.0_wp 2918 surf%cssws(lsp,num_v) = wall_csflux(lsp,component) 2919 ENDDO 2920 ENDIF 2921 2922 ! 2923 !-- So far, salinityflux at vertical surfaces is simply zero at the moment 2924 IF ( ocean_mode ) surf%sasws(num_v) = wall_salinityflux(component) 2925 ! 2926 !-- Increment wall indices 2927 num_v = num_v + 1 2928 num_v_kji = num_v_kji + 1 2929 2930 END SUBROUTINE initialize_vertical_surfaces 2931 2932 END SUBROUTINE init_surfaces 2933 2934 !--------------------------------------------------------------------------------------------------! 3024 2935 ! Description: 3025 2936 ! ------------ 3026 2937 !> Initialize single surface properties from 2D input arrays 3027 !------------------------------------------------------------------------------! 3028 SUBROUTINE init_single_surface_properties( var_surf, var_2d, & 3029 ns, fill_value, & 3030 index_space_i, & 3031 index_space_j & 3032 ) 3033 3034 INTEGER(iwp) :: m !< running index over surface elements 3035 INTEGER(iwp) :: ns !< number of surface elements in var_surf 3036 3037 INTEGER(iwp), DIMENSION(1:ns) :: index_space_i !< grid indices along x direction where surface properties should be defined 3038 INTEGER(iwp), DIMENSION(1:ns) :: index_space_j !< grid indices along y direction where surface properties should be defined 3039 3040 REAL(wp) :: fill_value !< fill value in var_2d 3041 3042 REAL(wp), DIMENSION(1:ns) :: var_surf !< 1D surface variable that should be initialized 3043 REAL(wp), DIMENSION(nys:nyn,nxl:nxr) :: var_2d !< input variable 3044 3045 DO m = 1, ns 3046 IF ( var_2d(index_space_j(m),index_space_i(m)) /= fill_value ) THEN 3047 var_surf(m) = var_2d(index_space_j(m),index_space_i(m)) 3048 ENDIF 3049 ENDDO 3050 3051 END SUBROUTINE init_single_surface_properties 3052 3053 !------------------------------------------------------------------------------! 2938 !--------------------------------------------------------------------------------------------------! 2939 SUBROUTINE init_single_surface_properties( var_surf, var_2d, ns, fill_value, index_space_i, & 2940 index_space_j ) 2941 2942 INTEGER(iwp) :: m !< running index over surface elements 2943 INTEGER(iwp) :: ns !< number of surface elements in var_surf 2944 2945 INTEGER(iwp), DIMENSION(1:ns) :: index_space_i !< grid indices along x direction where surface properties should be defined 2946 INTEGER(iwp), DIMENSION(1:ns) :: index_space_j !< grid indices along y direction where surface properties should be defined 2947 2948 REAL(wp) :: fill_value !< fill value in var_2d 2949 2950 REAL(wp), DIMENSION(1:ns) :: var_surf !< 1D surface variable that should be initialized 2951 REAL(wp), DIMENSION(nys:nyn,nxl:nxr) :: var_2d !< input variable 2952 2953 DO m = 1, ns 2954 IF ( var_2d(index_space_j(m),index_space_i(m)) /= fill_value ) THEN 2955 var_surf(m) = var_2d(index_space_j(m),index_space_i(m)) 2956 ENDIF 2957 ENDDO 2958 2959 END SUBROUTINE init_single_surface_properties 2960 2961 !--------------------------------------------------------------------------------------------------! 3054 2962 ! Description: 3055 2963 ! ------------ 3056 !> Gathers all surface elements with the same facing (but possibly different 3057 !> type) onto a surface type, and writes binary data into restart files. 3058 !------------------------------------------------------------------------------! 3059 SUBROUTINE surface_wrd_local 3060 3061 3062 IMPLICIT NONE 3063 3064 CHARACTER(LEN=1) :: dum !< dummy string to create output-variable name 3065 3066 INTEGER(iwp) :: i !< running index x-direction 3067 INTEGER(iwp) :: j !< running index y-direction 3068 INTEGER(iwp) :: l !< index surface type orientation 3069 INTEGER(iwp) :: lsp !< running index chemical species 3070 INTEGER(iwp) :: m !< running index for surface elements on individual surface array 3071 INTEGER(iwp), DIMENSION(0:2) :: start_index_h !< start index for horizontal surface elements on gathered surface array 3072 INTEGER(iwp), DIMENSION(0:3) :: mm !< running index for surface elements on gathered surface array 3073 INTEGER(iwp), DIMENSION(0:3) :: start_index_v !< start index for vertical surface elements on gathered surface array 3074 3075 INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) :: global_start_index !< index for surface data (MPI-IO) 3076 3077 LOGICAL :: surface_data_to_write !< switch for MPI-I/O if PE has surface data to write 3078 3079 TYPE(surf_type), DIMENSION(0:2) :: surf_h !< gathered horizontal surfaces, contains all surface types 3080 TYPE(surf_type), DIMENSION(0:3) :: surf_v !< gathered vertical surfaces, contains all surface types 3081 3082 ! 3083 !-- Determine total number of horizontal and vertical surface elements before 3084 !-- writing var_list 3085 CALL surface_last_actions 3086 ! 3087 !-- Count number of grid points with same facing and allocate attributes respectively 3088 !-- Horizontal upward facing 3089 surf_h(0)%ns = ns_h_on_file(0) 3090 CALL allocate_surface_attributes_h( surf_h(0), nys, nyn, nxl, nxr ) 3091 ! 3092 !-- Horizontal downward facing 3093 surf_h(1)%ns = ns_h_on_file(1) 3094 CALL allocate_surface_attributes_h( surf_h(1), nys, nyn, nxl, nxr ) 3095 ! 3096 !-- Model top 3097 surf_h(2)%ns = ns_h_on_file(2) 3098 CALL allocate_surface_attributes_h_top( surf_h(2), nys, nyn, nxl, nxr ) 3099 ! 3100 !-- Vertical surfaces 3101 DO l = 0, 3 3102 surf_v(l)%ns = ns_v_on_file(l) 3103 CALL allocate_surface_attributes_v( surf_v(l), & 3104 nys, nyn, nxl, nxr ) 3105 ENDDO 3106 ! 3107 !-- In the following, gather data from surfaces elements with the same 3108 !-- facing (but possibly differt type) on 1 data-type array. 3109 mm(0:2) = 1 3110 DO l = 0, 2 3111 DO i = nxl, nxr 3112 DO j = nys, nyn 3113 DO m = surf_def_h(l)%start_index(j,i), & 3114 surf_def_h(l)%end_index(j,i) 3115 IF ( ALLOCATED( surf_def_h(l)%us ) ) & 3116 surf_h(l)%us(mm(l)) = surf_def_h(l)%us(m) 3117 IF ( ALLOCATED( surf_def_h(l)%ts ) ) & 3118 surf_h(l)%ts(mm(l)) = surf_def_h(l)%ts(m) 3119 IF ( ALLOCATED( surf_def_h(l)%qs ) ) & 3120 surf_h(l)%qs(mm(l)) = surf_def_h(l)%qs(m) 3121 IF ( ALLOCATED( surf_def_h(l)%ss ) ) & 3122 surf_h(l)%ss(mm(l)) = surf_def_h(l)%ss(m) 3123 IF ( ALLOCATED( surf_def_h(l)%qcs ) ) & 3124 surf_h(l)%qcs(mm(l)) = surf_def_h(l)%qcs(m) 3125 IF ( ALLOCATED( surf_def_h(l)%ncs ) ) & 3126 surf_h(l)%ncs(mm(l)) = surf_def_h(l)%ncs(m) 3127 IF ( ALLOCATED( surf_def_h(l)%qis ) ) & 3128 surf_h(l)%qis(mm(l)) = surf_def_h(l)%qis(m) 3129 IF ( ALLOCATED( surf_def_h(l)%nis ) ) & 3130 surf_h(l)%nis(mm(l)) = surf_def_h(l)%nis(m) 3131 IF ( ALLOCATED( surf_def_h(l)%qrs ) ) & 3132 surf_h(l)%qrs(mm(l)) = surf_def_h(l)%qrs(m) 3133 IF ( ALLOCATED( surf_def_h(l)%nrs ) ) & 3134 surf_h(l)%nrs(mm(l)) = surf_def_h(l)%nrs(m) 3135 IF ( ALLOCATED( surf_def_h(l)%ol ) ) & 3136 surf_h(l)%ol(mm(l)) = surf_def_h(l)%ol(m) 3137 IF ( ALLOCATED( surf_def_h(l)%rib ) ) & 3138 surf_h(l)%rib(mm(l)) = surf_def_h(l)%rib(m) 3139 IF ( ALLOCATED( surf_def_h(l)%pt_surface ) ) & 3140 surf_h(l)%pt_surface(mm(l)) = surf_def_h(l)%pt_surface(m) 3141 IF ( ALLOCATED( surf_def_h(l)%q_surface ) ) & 3142 surf_h(l)%q_surface(mm(l)) = surf_def_h(l)%q_surface(m) 3143 IF ( ALLOCATED( surf_def_h(l)%vpt_surface ) ) & 3144 surf_h(l)%vpt_surface(mm(l)) = surf_def_h(l)%vpt_surface(m) 3145 IF ( ALLOCATED( surf_def_h(l)%usws ) ) & 3146 surf_h(l)%usws(mm(l)) = surf_def_h(l)%usws(m) 3147 IF ( ALLOCATED( surf_def_h(l)%vsws ) ) & 3148 surf_h(l)%vsws(mm(l)) = surf_def_h(l)%vsws(m) 3149 IF ( ALLOCATED( surf_def_h(l)%shf ) ) & 3150 surf_h(l)%shf(mm(l)) = surf_def_h(l)%shf(m) 3151 IF ( ALLOCATED( surf_def_h(l)%qsws ) ) & 3152 surf_h(l)%qsws(mm(l)) = surf_def_h(l)%qsws(m) 3153 IF ( ALLOCATED( surf_def_h(l)%ssws ) ) & 3154 surf_h(l)%ssws(mm(l)) = surf_def_h(l)%ssws(m) 3155 IF ( ALLOCATED( surf_def_h(l)%css ) ) THEN 3156 DO lsp = 1,nvar 3157 surf_h(l)%css(lsp,mm(l)) = surf_def_h(l)%css(lsp,m) 2964 !> Gathers all surface elements with the same facing (but possibly different type) onto a surface 2965 !> type, and writes binary data into restart files. 2966 !--------------------------------------------------------------------------------------------------! 2967 SUBROUTINE surface_wrd_local 2968 2969 2970 IMPLICIT NONE 2971 2972 CHARACTER(LEN=1) :: dum !< dummy string to create output-variable name 2973 2974 INTEGER(iwp) :: i !< running index x-direction 2975 INTEGER(iwp) :: j !< running index y-direction 2976 INTEGER(iwp) :: l !< index surface type orientation 2977 INTEGER(iwp) :: lsp !< running index chemical species 2978 INTEGER(iwp) :: m !< running index for surface elements on individual surface array 2979 INTEGER(iwp), DIMENSION(0:2) :: start_index_h !< start index for horizontal surface elements on gathered surface array 2980 INTEGER(iwp), DIMENSION(0:3) :: mm !< running index for surface elements on gathered surface array 2981 INTEGER(iwp), DIMENSION(0:3) :: start_index_v !< start index for vertical surface elements on gathered surface array 2982 2983 INTEGER(iwp),DIMENSION(nys:nyn,nxl:nxr) :: global_start_index !< index for surface data (MPI-IO) 2984 2985 LOGICAL :: surface_data_to_write !< switch for MPI-I/O if PE has surface data to write 2986 2987 TYPE(surf_type), DIMENSION(0:2) :: surf_h !< gathered horizontal surfaces, contains all surface types 2988 TYPE(surf_type), DIMENSION(0:3) :: surf_v !< gathered vertical surfaces, contains all surface types 2989 2990 ! 2991 !-- Determine total number of horizontal and vertical surface elements before writing var_list 2992 CALL surface_last_actions 2993 ! 2994 !-- Count number of grid points with same facing and allocate attributes respectively 2995 !-- Horizontal upward facing 2996 surf_h(0)%ns = ns_h_on_file(0) 2997 CALL allocate_surface_attributes_h( surf_h(0), nys, nyn, nxl, nxr ) 2998 ! 2999 !-- Horizontal downward facing 3000 surf_h(1)%ns = ns_h_on_file(1) 3001 CALL allocate_surface_attributes_h( surf_h(1), nys, nyn, nxl, nxr ) 3002 ! 3003 !-- Model top 3004 surf_h(2)%ns = ns_h_on_file(2) 3005 CALL allocate_surface_attributes_h_top( surf_h(2), nys, nyn, nxl, nxr ) 3006 ! 3007 !-- Vertical surfaces 3008 DO l = 0, 3 3009 surf_v(l)%ns = ns_v_on_file(l) 3010 CALL allocate_surface_attributes_v( surf_v(l), nys, nyn, nxl, nxr ) 3011 ENDDO 3012 ! 3013 !-- In the following, gather data from surfaces elements with the same facing (but possibly differt 3014 !-- type) on 1 data-type array. 3015 mm(0:2) = 1 3016 DO l = 0, 2 3017 DO i = nxl, nxr 3018 DO j = nys, nyn 3019 DO m = surf_def_h(l)%start_index(j,i), surf_def_h(l)%end_index(j,i) 3020 IF ( ALLOCATED( surf_def_h(l)%us ) ) surf_h(l)%us(mm(l)) = surf_def_h(l)%us(m) 3021 IF ( ALLOCATED( surf_def_h(l)%ts ) ) surf_h(l)%ts(mm(l)) = surf_def_h(l)%ts(m) 3022 IF ( ALLOCATED( surf_def_h(l)%qs ) ) surf_h(l)%qs(mm(l)) = surf_def_h(l)%qs(m) 3023 IF ( ALLOCATED( surf_def_h(l)%ss ) ) surf_h(l)%ss(mm(l)) = surf_def_h(l)%ss(m) 3024 IF ( ALLOCATED( surf_def_h(l)%qcs ) ) surf_h(l)%qcs(mm(l)) = surf_def_h(l)%qcs(m) 3025 IF ( ALLOCATED( surf_def_h(l)%ncs ) ) surf_h(l)%ncs(mm(l)) = surf_def_h(l)%ncs(m) 3026 IF ( ALLOCATED( surf_def_h(l)%qis ) ) surf_h(l)%qis(mm(l)) = surf_def_h(l)%qis(m) 3027 IF ( ALLOCATED( surf_def_h(l)%nis ) ) surf_h(l)%nis(mm(l)) = surf_def_h(l)%nis(m) 3028 IF ( ALLOCATED( surf_def_h(l)%qrs ) ) surf_h(l)%qrs(mm(l)) = surf_def_h(l)%qrs(m) 3029 IF ( ALLOCATED( surf_def_h(l)%nrs ) ) surf_h(l)%nrs(mm(l)) = surf_def_h(l)%nrs(m) 3030 IF ( ALLOCATED( surf_def_h(l)%ol ) ) surf_h(l)%ol(mm(l)) = surf_def_h(l)%ol(m) 3031 IF ( ALLOCATED( surf_def_h(l)%rib ) ) surf_h(l)%rib(mm(l)) = surf_def_h(l)%rib(m) 3032 IF ( ALLOCATED( surf_def_h(l)%pt_surface ) ) & 3033 surf_h(l)%pt_surface(mm(l)) = surf_def_h(l)%pt_surface(m) 3034 IF ( ALLOCATED( surf_def_h(l)%q_surface ) ) & 3035 surf_h(l)%q_surface(mm(l)) = surf_def_h(l)%q_surface(m) 3036 IF ( ALLOCATED( surf_def_h(l)%vpt_surface ) ) & 3037 surf_h(l)%vpt_surface(mm(l)) = surf_def_h(l)%vpt_surface(m) 3038 IF ( ALLOCATED( surf_def_h(l)%usws ) ) surf_h(l)%usws(mm(l)) = surf_def_h(l)%usws(m) 3039 IF ( ALLOCATED( surf_def_h(l)%vsws ) ) surf_h(l)%vsws(mm(l)) = surf_def_h(l)%vsws(m) 3040 IF ( ALLOCATED( surf_def_h(l)%shf ) ) surf_h(l)%shf(mm(l)) = surf_def_h(l)%shf(m) 3041 IF ( ALLOCATED( surf_def_h(l)%qsws ) ) surf_h(l)%qsws(mm(l)) = surf_def_h(l)%qsws(m) 3042 IF ( ALLOCATED( surf_def_h(l)%ssws ) ) surf_h(l)%ssws(mm(l)) = surf_def_h(l)%ssws(m) 3043 IF ( ALLOCATED( surf_def_h(l)%css ) ) THEN 3044 DO lsp = 1,nvar 3045 surf_h(l)%css(lsp,mm(l)) = surf_def_h(l)%css(lsp,m) 3046 ENDDO 3047 ENDIF 3048 IF ( ALLOCATED( surf_def_h(l)%cssws ) ) THEN 3049 DO lsp = 1,nvar 3050 surf_h(l)%cssws(lsp,mm(l)) = surf_def_h(l)%cssws(lsp,m) 3051 ENDDO 3052 ENDIF 3053 IF ( ALLOCATED( surf_def_h(l)%qcsws ) ) & 3054 surf_h(l)%qcsws(mm(l)) = surf_def_h(l)%qcsws(m) 3055 IF ( ALLOCATED( surf_def_h(l)%qrsws ) ) & 3056 surf_h(l)%qrsws(mm(l)) = surf_def_h(l)%qrsws(m) 3057 IF ( ALLOCATED( surf_def_h(l)%qisws ) ) & 3058 surf_h(l)%qisws(mm(l)) = surf_def_h(l)%qisws(m) 3059 IF ( ALLOCATED( surf_def_h(l)%ncsws ) ) & 3060 surf_h(l)%ncsws(mm(l)) = surf_def_h(l)%ncsws(m) 3061 IF ( ALLOCATED( surf_def_h(l)%nisws ) ) & 3062 surf_h(l)%nisws(mm(l)) = surf_def_h(l)%nisws(m) 3063 IF ( ALLOCATED( surf_def_h(l)%nrsws ) ) & 3064 surf_h(l)%nrsws(mm(l)) = surf_def_h(l)%nrsws(m) 3065 IF ( ALLOCATED( surf_def_h(l)%sasws ) ) & 3066 surf_h(l)%sasws(mm(l)) = surf_def_h(l)%sasws(m) 3067 3068 mm(l) = mm(l) + 1 3069 ENDDO 3070 3071 IF ( l == 0 ) THEN 3072 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 3073 IF ( ALLOCATED( surf_lsm_h%us ) ) surf_h(0)%us(mm(0)) = surf_lsm_h%us(m) 3074 IF ( ALLOCATED( surf_lsm_h%ts ) ) surf_h(0)%ts(mm(0)) = surf_lsm_h%ts(m) 3075 IF ( ALLOCATED( surf_lsm_h%qs ) ) surf_h(0)%qs(mm(0)) = surf_lsm_h%qs(m) 3076 IF ( ALLOCATED( surf_lsm_h%ss ) ) surf_h(0)%ss(mm(0)) = surf_lsm_h%ss(m) 3077 IF ( ALLOCATED( surf_lsm_h%qcs ) ) surf_h(0)%qcs(mm(0)) = surf_lsm_h%qcs(m) 3078 IF ( ALLOCATED( surf_lsm_h%ncs ) ) surf_h(0)%ncs(mm(0)) = surf_lsm_h%ncs(m) 3079 IF ( ALLOCATED( surf_lsm_h%qis ) ) surf_h(0)%qis(mm(0)) = surf_lsm_h%qis(m) 3080 IF ( ALLOCATED( surf_lsm_h%nis ) ) surf_h(0)%nis(mm(0)) = surf_lsm_h%nis(m) 3081 IF ( ALLOCATED( surf_lsm_h%qrs ) ) surf_h(0)%qrs(mm(0)) = surf_lsm_h%qrs(m) 3082 IF ( ALLOCATED( surf_lsm_h%nrs ) ) surf_h(0)%nrs(mm(0)) = surf_lsm_h%nrs(m) 3083 IF ( ALLOCATED( surf_lsm_h%ol ) ) surf_h(0)%ol(mm(0)) = surf_lsm_h%ol(m) 3084 IF ( ALLOCATED( surf_lsm_h%rib ) ) surf_h(0)%rib(mm(0)) = surf_lsm_h%rib(m) 3085 IF ( ALLOCATED( surf_lsm_h%pt_surface ) ) & 3086 surf_h(l)%pt_surface(mm(l)) = surf_lsm_h%pt_surface(m) 3087 IF ( ALLOCATED( surf_def_h(l)%q_surface ) ) & 3088 surf_h(l)%q_surface(mm(l)) = surf_lsm_h%q_surface(m) 3089 IF ( ALLOCATED( surf_def_h(l)%vpt_surface ) ) & 3090 surf_h(l)%vpt_surface(mm(l)) = surf_lsm_h%vpt_surface(m) 3091 IF ( ALLOCATED( surf_lsm_h%usws ) ) surf_h(0)%usws(mm(0)) = surf_lsm_h%usws(m) 3092 IF ( ALLOCATED( surf_lsm_h%vsws ) ) surf_h(0)%vsws(mm(0)) = surf_lsm_h%vsws(m) 3093 IF ( ALLOCATED( surf_lsm_h%shf ) ) surf_h(0)%shf(mm(0)) = surf_lsm_h%shf(m) 3094 IF ( ALLOCATED( surf_lsm_h%qsws ) ) surf_h(0)%qsws(mm(0)) = surf_lsm_h%qsws(m) 3095 IF ( ALLOCATED( surf_lsm_h%ssws ) ) surf_h(0)%ssws(mm(0)) = surf_lsm_h%ssws(m) 3096 IF ( ALLOCATED( surf_lsm_h%css ) ) THEN 3097 DO lsp = 1, nvar 3098 surf_h(0)%css(lsp,mm(0)) = surf_lsm_h%css(lsp,m) 3158 3099 ENDDO 3159 3100 ENDIF 3160 IF ( ALLOCATED( surf_ def_h(l)%cssws ) ) THEN3161 DO lsp = 1, nvar3162 surf_h( l)%cssws(lsp,mm(l)) = surf_def_h(l)%cssws(lsp,m)3101 IF ( ALLOCATED( surf_lsm_h%cssws ) ) THEN 3102 DO lsp = 1, nvar 3103 surf_h(0)%cssws(lsp,mm(0)) = surf_lsm_h%cssws(lsp,m) 3163 3104 ENDDO 3164 3105 ENDIF 3165 IF ( ALLOCATED( surf_def_h(l)%qcsws ) ) & 3166 surf_h(l)%qcsws(mm(l)) = surf_def_h(l)%qcsws(m) 3167 IF ( ALLOCATED( surf_def_h(l)%qrsws ) ) & 3168 surf_h(l)%qrsws(mm(l)) = surf_def_h(l)%qrsws(m) 3169 IF ( ALLOCATED( surf_def_h(l)%qisws ) ) & 3170 surf_h(l)%qisws(mm(l)) = surf_def_h(l)%qisws(m) 3171 IF ( ALLOCATED( surf_def_h(l)%ncsws ) ) & 3172 surf_h(l)%ncsws(mm(l)) = surf_def_h(l)%ncsws(m) 3173 IF ( ALLOCATED( surf_def_h(l)%nisws ) ) & 3174 surf_h(l)%nisws(mm(l)) = surf_def_h(l)%nisws(m) 3175 IF ( ALLOCATED( surf_def_h(l)%nrsws ) ) & 3176 surf_h(l)%nrsws(mm(l)) = surf_def_h(l)%nrsws(m) 3177 IF ( ALLOCATED( surf_def_h(l)%sasws ) ) & 3178 surf_h(l)%sasws(mm(l)) = surf_def_h(l)%sasws(m) 3179 3180 mm(l) = mm(l) + 1 3106 IF ( ALLOCATED( surf_lsm_h%qcsws ) ) & 3107 surf_h(0)%qcsws(mm(0)) = surf_lsm_h%qcsws(m) 3108 IF ( ALLOCATED( surf_lsm_h%qisws ) ) & 3109 surf_h(0)%qisws(mm(0)) = surf_lsm_h%qisws(m) 3110 IF ( ALLOCATED( surf_lsm_h%qrsws ) ) & 3111 surf_h(0)%qrsws(mm(0)) = surf_lsm_h%qrsws(m) 3112 IF ( ALLOCATED( surf_lsm_h%ncsws ) ) & 3113 surf_h(0)%ncsws(mm(0)) = surf_lsm_h%ncsws(m) 3114 IF ( ALLOCATED( surf_lsm_h%nisws ) ) & 3115 surf_h(0)%nisws(mm(0)) = surf_lsm_h%nisws(m) 3116 IF ( ALLOCATED( surf_lsm_h%nrsws ) ) & 3117 surf_h(0)%nrsws(mm(0)) = surf_lsm_h%nrsws(m) 3118 IF ( ALLOCATED( surf_lsm_h%sasws ) ) & 3119 surf_h(0)%sasws(mm(0)) = surf_lsm_h%sasws(m) 3120 3121 mm(0) = mm(0) + 1 3122 3181 3123 ENDDO 3182 3124 3183 IF ( l == 0 ) THEN 3184 DO m = surf_lsm_h%start_index(j,i), & 3185 surf_lsm_h%end_index(j,i) 3186 IF ( ALLOCATED( surf_lsm_h%us ) ) & 3187 surf_h(0)%us(mm(0)) = surf_lsm_h%us(m) 3188 IF ( ALLOCATED( surf_lsm_h%ts ) ) & 3189 surf_h(0)%ts(mm(0)) = surf_lsm_h%ts(m) 3190 IF ( ALLOCATED( surf_lsm_h%qs ) ) & 3191 surf_h(0)%qs(mm(0)) = surf_lsm_h%qs(m) 3192 IF ( ALLOCATED( surf_lsm_h%ss ) ) & 3193 surf_h(0)%ss(mm(0)) = surf_lsm_h%ss(m) 3194 IF ( ALLOCATED( surf_lsm_h%qcs ) ) & 3195 surf_h(0)%qcs(mm(0)) = surf_lsm_h%qcs(m) 3196 IF ( ALLOCATED( surf_lsm_h%ncs ) ) & 3197 surf_h(0)%ncs(mm(0)) = surf_lsm_h%ncs(m) 3198 IF ( ALLOCATED( surf_lsm_h%qis ) ) & 3199 surf_h(0)%qis(mm(0)) = surf_lsm_h%qis(m) 3200 IF ( ALLOCATED( surf_lsm_h%nis ) ) & 3201 surf_h(0)%nis(mm(0)) = surf_lsm_h%nis(m) 3202 IF ( ALLOCATED( surf_lsm_h%qrs ) ) & 3203 surf_h(0)%qrs(mm(0)) = surf_lsm_h%qrs(m) 3204 IF ( ALLOCATED( surf_lsm_h%nrs ) ) & 3205 surf_h(0)%nrs(mm(0)) = surf_lsm_h%nrs(m) 3206 IF ( ALLOCATED( surf_lsm_h%ol ) ) & 3207 surf_h(0)%ol(mm(0)) = surf_lsm_h%ol(m) 3208 IF ( ALLOCATED( surf_lsm_h%rib ) ) & 3209 surf_h(0)%rib(mm(0)) = surf_lsm_h%rib(m) 3210 IF ( ALLOCATED( surf_lsm_h%pt_surface ) ) & 3211 surf_h(l)%pt_surface(mm(l)) = surf_lsm_h%pt_surface(m) 3212 IF ( ALLOCATED( surf_def_h(l)%q_surface ) ) & 3213 surf_h(l)%q_surface(mm(l)) = surf_lsm_h%q_surface(m) 3214 IF ( ALLOCATED( surf_def_h(l)%vpt_surface ) ) & 3215 surf_h(l)%vpt_surface(mm(l)) = surf_lsm_h%vpt_surface(m) 3216 IF ( ALLOCATED( surf_lsm_h%usws ) ) & 3217 surf_h(0)%usws(mm(0)) = surf_lsm_h%usws(m) 3218 IF ( ALLOCATED( surf_lsm_h%vsws ) ) & 3219 surf_h(0)%vsws(mm(0)) = surf_lsm_h%vsws(m) 3220 IF ( ALLOCATED( surf_lsm_h%shf ) ) & 3221 surf_h(0)%shf(mm(0)) = surf_lsm_h%shf(m) 3222 IF ( ALLOCATED( surf_lsm_h%qsws ) ) & 3223 surf_h(0)%qsws(mm(0)) = surf_lsm_h%qsws(m) 3224 IF ( ALLOCATED( surf_lsm_h%ssws ) ) & 3225 surf_h(0)%ssws(mm(0)) = surf_lsm_h%ssws(m) 3226 IF ( ALLOCATED( surf_lsm_h%css ) ) THEN 3227 DO lsp = 1, nvar 3228 surf_h(0)%css(lsp,mm(0)) = surf_lsm_h%css(lsp,m) 3229 ENDDO 3230 ENDIF 3231 IF ( ALLOCATED( surf_lsm_h%cssws ) ) THEN 3232 DO lsp = 1, nvar 3233 surf_h(0)%cssws(lsp,mm(0)) = surf_lsm_h%cssws(lsp,m) 3234 ENDDO 3235 ENDIF 3236 IF ( ALLOCATED( surf_lsm_h%qcsws ) ) & 3237 surf_h(0)%qcsws(mm(0)) = surf_lsm_h%qcsws(m) 3238 IF ( ALLOCATED( surf_lsm_h%qisws ) ) & 3239 surf_h(0)%qisws(mm(0)) = surf_lsm_h%qisws(m) 3240 IF ( ALLOCATED( surf_lsm_h%qrsws ) ) & 3241 surf_h(0)%qrsws(mm(0)) = surf_lsm_h%qrsws(m) 3242 IF ( ALLOCATED( surf_lsm_h%ncsws ) ) & 3243 surf_h(0)%ncsws(mm(0)) = surf_lsm_h%ncsws(m) 3244 IF ( ALLOCATED( surf_lsm_h%nisws ) ) & 3245 surf_h(0)%nisws(mm(0)) = surf_lsm_h%nisws(m) 3246 IF ( ALLOCATED( surf_lsm_h%nrsws ) ) & 3247 surf_h(0)%nrsws(mm(0)) = surf_lsm_h%nrsws(m) 3248 IF ( ALLOCATED( surf_lsm_h%sasws ) ) & 3249 surf_h(0)%sasws(mm(0)) = surf_lsm_h%sasws(m) 3250 3251 mm(0) = mm(0) + 1 3252 3253 ENDDO 3254 3255 DO m = surf_usm_h%start_index(j,i), & 3256 surf_usm_h%end_index(j,i) 3257 IF ( ALLOCATED( surf_usm_h%us ) ) & 3258 surf_h(0)%us(mm(0)) = surf_usm_h%us(m) 3259 IF ( ALLOCATED( surf_usm_h%ts ) ) & 3260 surf_h(0)%ts(mm(0)) = surf_usm_h%ts(m) 3261 IF ( ALLOCATED( surf_usm_h%qs ) ) & 3262 surf_h(0)%qs(mm(0)) = surf_usm_h%qs(m) 3263 IF ( ALLOCATED( surf_usm_h%ss ) ) & 3264 surf_h(0)%ss(mm(0)) = surf_usm_h%ss(m) 3265 IF ( ALLOCATED( surf_usm_h%qcs ) ) & 3266 surf_h(0)%qcs(mm(0)) = surf_usm_h%qcs(m) 3267 IF ( ALLOCATED( surf_usm_h%ncs ) ) & 3268 surf_h(0)%ncs(mm(0)) = surf_usm_h%ncs(m) 3269 IF ( ALLOCATED( surf_usm_h%qis ) ) & 3270 surf_h(0)%qis(mm(0)) = surf_usm_h%qis(m) 3271 IF ( ALLOCATED( surf_usm_h%nis ) ) & 3272 surf_h(0)%nis(mm(0)) = surf_usm_h%nis(m) 3273 IF ( ALLOCATED( surf_usm_h%qrs ) ) & 3274 surf_h(0)%qrs(mm(0)) = surf_usm_h%qrs(m) 3275 IF ( ALLOCATED( surf_usm_h%nrs ) ) & 3276 surf_h(0)%nrs(mm(0)) = surf_usm_h%nrs(m) 3277 IF ( ALLOCATED( surf_usm_h%ol ) ) & 3278 surf_h(0)%ol(mm(0)) = surf_usm_h%ol(m) 3279 IF ( ALLOCATED( surf_usm_h%rib ) ) & 3280 surf_h(0)%rib(mm(0)) = surf_usm_h%rib(m) 3281 IF ( ALLOCATED( surf_usm_h%pt_surface ) ) & 3282 surf_h(l)%pt_surface(mm(l)) = surf_usm_h%pt_surface(m) 3283 IF ( ALLOCATED( surf_usm_h%q_surface ) ) & 3284 surf_h(l)%q_surface(mm(l)) = surf_usm_h%q_surface(m) 3285 IF ( ALLOCATED( surf_usm_h%vpt_surface ) ) & 3286 surf_h(l)%vpt_surface(mm(l)) = surf_usm_h%vpt_surface(m) 3287 IF ( ALLOCATED( surf_usm_h%usws ) ) & 3288 surf_h(0)%usws(mm(0)) = surf_usm_h%usws(m) 3289 IF ( ALLOCATED( surf_usm_h%vsws ) ) & 3290 surf_h(0)%vsws(mm(0)) = surf_usm_h%vsws(m) 3291 IF ( ALLOCATED( surf_usm_h%shf ) ) & 3292 surf_h(0)%shf(mm(0)) = surf_usm_h%shf(m) 3293 IF ( ALLOCATED( surf_usm_h%qsws ) ) & 3294 surf_h(0)%qsws(mm(0)) = surf_usm_h%qsws(m) 3295 IF ( ALLOCATED( surf_usm_h%ssws ) ) & 3296 surf_h(0)%ssws(mm(0)) = surf_usm_h%ssws(m) 3297 IF ( ALLOCATED( surf_usm_h%css ) ) THEN 3298 DO lsp = 1, nvar 3299 surf_h(0)%css(lsp,mm(0)) = surf_usm_h%css(lsp,m) 3300 ENDDO 3301 ENDIF 3302 IF ( ALLOCATED( surf_usm_h%cssws ) ) THEN 3303 DO lsp = 1, nvar 3304 surf_h(0)%cssws(lsp,mm(0)) = surf_usm_h%cssws(lsp,m) 3305 ENDDO 3306 ENDIF 3307 IF ( ALLOCATED( surf_usm_h%qcsws ) ) & 3308 surf_h(0)%qcsws(mm(0)) = surf_usm_h%qcsws(m) 3309 IF ( ALLOCATED( surf_usm_h%qisws ) ) & 3310 surf_h(0)%qisws(mm(0)) = surf_usm_h%qisws(m) 3311 IF ( ALLOCATED( surf_usm_h%qrsws ) ) & 3312 surf_h(0)%qrsws(mm(0)) = surf_usm_h%qrsws(m) 3313 IF ( ALLOCATED( surf_usm_h%ncsws ) ) & 3314 surf_h(0)%ncsws(mm(0)) = surf_usm_h%ncsws(m) 3315 IF ( ALLOCATED( surf_usm_h%nrsws ) ) & 3316 surf_h(0)%nrsws(mm(0)) = surf_usm_h%nrsws(m) 3317 IF ( ALLOCATED( surf_usm_h%nisws ) ) & 3318 surf_h(0)%nisws(mm(0)) = surf_usm_h%nisws(m) 3319 IF ( ALLOCATED( surf_usm_h%sasws ) ) & 3320 surf_h(0)%sasws(mm(0)) = surf_usm_h%sasws(m) 3321 3322 mm(0) = mm(0) + 1 3323 3324 ENDDO 3325 3326 3327 ENDIF 3328 3125 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 3126 IF ( ALLOCATED( surf_usm_h%us ) ) & 3127 surf_h(0)%us(mm(0)) = surf_usm_h%us(m) 3128 IF ( ALLOCATED( surf_usm_h%ts ) ) & 3129 surf_h(0)%ts(mm(0)) = surf_usm_h%ts(m) 3130 IF ( ALLOCATED( surf_usm_h%qs ) ) & 3131 surf_h(0)%qs(mm(0)) = surf_usm_h%qs(m) 3132 IF ( ALLOCATED( surf_usm_h%ss ) ) & 3133 surf_h(0)%ss(mm(0)) = surf_usm_h%ss(m) 3134 IF ( ALLOCATED( surf_usm_h%qcs ) ) & 3135 surf_h(0)%qcs(mm(0)) = surf_usm_h%qcs(m) 3136 IF ( ALLOCATED( surf_usm_h%ncs ) ) & 3137 surf_h(0)%ncs(mm(0)) = surf_usm_h%ncs(m) 3138 IF ( ALLOCATED( surf_usm_h%qis ) ) & 3139 surf_h(0)%qis(mm(0)) = surf_usm_h%qis(m) 3140 IF ( ALLOCATED( surf_usm_h%nis ) ) & 3141 surf_h(0)%nis(mm(0)) = surf_usm_h%nis(m) 3142 IF ( ALLOCATED( surf_usm_h%qrs ) ) & 3143 surf_h(0)%qrs(mm(0)) = surf_usm_h%qrs(m) 3144 IF ( ALLOCATED( surf_usm_h%nrs ) ) & 3145 surf_h(0)%nrs(mm(0)) = surf_usm_h%nrs(m) 3146 IF ( ALLOCATED( surf_usm_h%ol ) ) & 3147 surf_h(0)%ol(mm(0)) = surf_usm_h%ol(m) 3148 IF ( ALLOCATED( surf_usm_h%rib ) ) & 3149 surf_h(0)%rib(mm(0)) = surf_usm_h%rib(m) 3150 IF ( ALLOCATED( surf_usm_h%pt_surface ) ) & 3151 surf_h(l)%pt_surface(mm(l)) = surf_usm_h%pt_surface(m) 3152 IF ( ALLOCATED( surf_usm_h%q_surface ) ) & 3153 surf_h(l)%q_surface(mm(l)) = surf_usm_h%q_surface(m) 3154 IF ( ALLOCATED( surf_usm_h%vpt_surface ) ) & 3155 surf_h(l)%vpt_surface(mm(l)) = surf_usm_h%vpt_surface(m) 3156 IF ( ALLOCATED( surf_usm_h%usws ) ) & 3157 surf_h(0)%usws(mm(0)) = surf_usm_h%usws(m) 3158 IF ( ALLOCATED( surf_usm_h%vsws ) ) & 3159 surf_h(0)%vsws(mm(0)) = surf_usm_h%vsws(m) 3160 IF ( ALLOCATED( surf_usm_h%shf ) ) & 3161 surf_h(0)%shf(mm(0)) = surf_usm_h%shf(m) 3162 IF ( ALLOCATED( surf_usm_h%qsws ) ) & 3163 surf_h(0)%qsws(mm(0)) = surf_usm_h%qsws(m) 3164 IF ( ALLOCATED( surf_usm_h%ssws ) ) & 3165 surf_h(0)%ssws(mm(0)) = surf_usm_h%ssws(m) 3166 IF ( ALLOCATED( surf_usm_h%css ) ) THEN 3167 DO lsp = 1, nvar 3168 surf_h(0)%css(lsp,mm(0)) = surf_usm_h%css(lsp,m) 3169 ENDDO 3170 ENDIF 3171 IF ( ALLOCATED( surf_usm_h%cssws ) ) THEN 3172 DO lsp = 1, nvar 3173 surf_h(0)%cssws(lsp,mm(0)) = surf_usm_h%cssws(lsp,m) 3174 ENDDO 3175 ENDIF 3176 IF ( ALLOCATED( surf_usm_h%qcsws ) ) & 3177 surf_h(0)%qcsws(mm(0)) = surf_usm_h%qcsws(m) 3178 IF ( ALLOCATED( surf_usm_h%qisws ) ) & 3179 surf_h(0)%qisws(mm(0)) = surf_usm_h%qisws(m) 3180 IF ( ALLOCATED( surf_usm_h%qrsws ) ) & 3181 surf_h(0)%qrsws(mm(0)) = surf_usm_h%qrsws(m) 3182 IF ( ALLOCATED( surf_usm_h%ncsws ) ) & 3183 surf_h(0)%ncsws(mm(0)) = surf_usm_h%ncsws(m) 3184 IF ( ALLOCATED( surf_usm_h%nrsws ) ) & 3185 surf_h(0)%nrsws(mm(0)) = surf_usm_h%nrsws(m) 3186 IF ( ALLOCATED( surf_usm_h%nisws ) ) & 3187 surf_h(0)%nisws(mm(0)) = surf_usm_h%nisws(m) 3188 IF ( ALLOCATED( surf_usm_h%sasws ) ) & 3189 surf_h(0)%sasws(mm(0)) = surf_usm_h%sasws(m) 3190 3191 mm(0) = mm(0) + 1 3192 3193 ENDDO 3194 3195 3196 ENDIF 3197 3198 ENDDO 3199 3200 ENDDO 3201 ! 3202 !-- Recalculate start- and end indices for gathered surface type. 3203 start_index_h(l) = 1 3204 DO i = nxl, nxr 3205 DO j = nys, nyn 3206 3207 surf_h(l)%start_index(j,i) = start_index_h(l) 3208 surf_h(l)%end_index(j,i) = surf_h(l)%start_index(j,i) - 1 3209 3210 DO m = surf_def_h(l)%start_index(j,i), surf_def_h(l)%end_index(j,i) 3211 surf_h(l)%end_index(j,i) = surf_h(l)%end_index(j,i) + 1 3329 3212 ENDDO 3330 3331 ENDDO 3332 ! 3333 !-- Recalculate start- and end indices for gathered surface type. 3334 start_index_h(l) = 1 3335 DO i = nxl, nxr 3336 DO j = nys, nyn 3337 3338 surf_h(l)%start_index(j,i) = start_index_h(l) 3339 surf_h(l)%end_index(j,i) = surf_h(l)%start_index(j,i) - 1 3340 3341 DO m = surf_def_h(l)%start_index(j,i), & 3342 surf_def_h(l)%end_index(j,i) 3213 IF ( l == 0 ) THEN 3214 DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i) 3343 3215 surf_h(l)%end_index(j,i) = surf_h(l)%end_index(j,i) + 1 3344 3216 ENDDO 3345 IF ( l == 0 ) THEN 3346 DO m = surf_lsm_h%start_index(j,i), & 3347 surf_lsm_h%end_index(j,i) 3348 surf_h(l)%end_index(j,i) = surf_h(l)%end_index(j,i) + 1 3349 ENDDO 3350 DO m = surf_usm_h%start_index(j,i), & 3351 surf_usm_h%end_index(j,i) 3352 surf_h(l)%end_index(j,i) = surf_h(l)%end_index(j,i) + 1 3217 DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i) 3218 surf_h(l)%end_index(j,i) = surf_h(l)%end_index(j,i) + 1 3219 ENDDO 3220 ENDIF 3221 3222 start_index_h(l) = surf_h(l)%end_index(j,i) + 1 3223 3224 ENDDO 3225 ENDDO 3226 ENDDO 3227 ! 3228 !-- Treat vertically orientated surface. Again, gather data from different surfaces types but 3229 !-- identical orientation (e.g. northward-facing) onto one surface type which is output afterwards. 3230 mm(0:3) = 1 3231 DO l = 0, 3 3232 DO i = nxl, nxr 3233 DO j = nys, nyn 3234 DO m = surf_def_v(l)%start_index(j,i), surf_def_v(l)%end_index(j,i) 3235 IF ( ALLOCATED( surf_def_v(l)%us ) ) & 3236 surf_v(l)%us(mm(l)) = surf_def_v(l)%us(m) 3237 IF ( ALLOCATED( surf_def_v(l)%ts ) ) & 3238 surf_v(l)%ts(mm(l)) = surf_def_v(l)%ts(m) 3239 IF ( ALLOCATED( surf_def_v(l)%qs ) ) & 3240 surf_v(l)%qs(mm(l)) = surf_def_v(l)%qs(m) 3241 IF ( ALLOCATED( surf_def_v(l)%ss ) ) & 3242 surf_v(l)%ss(mm(l)) = surf_def_v(l)%ss(m) 3243 IF ( ALLOCATED( surf_def_v(l)%qcs ) ) & 3244 surf_v(l)%qcs(mm(l)) = surf_def_v(l)%qcs(m) 3245 IF ( ALLOCATED( surf_def_v(l)%ncs ) ) & 3246 surf_v(l)%ncs(mm(l)) = surf_def_v(l)%ncs(m) 3247 IF ( ALLOCATED( surf_def_v(l)%qis ) ) & 3248 surf_v(l)%qis(mm(l)) = surf_def_v(l)%qis(m) 3249 IF ( ALLOCATED( surf_def_v(l)%nis ) ) & 3250 surf_v(l)%nis(mm(l)) = surf_def_v(l)%nis(m) 3251 IF ( ALLOCATED( surf_def_v(l)%qrs ) ) & 3252 surf_v(l)%qrs(mm(l)) = surf_def_v(l)%qrs(m) 3253 IF ( ALLOCATED( surf_def_v(l)%nrs ) ) & 3254 surf_v(l)%nrs(mm(l)) = surf_def_v(l)%nrs(m) 3255 IF ( ALLOCATED( surf_def_v(l)%ol ) ) & 3256 surf_v(l)%ol(mm(l)) = surf_def_v(l)%ol(m) 3257 IF ( ALLOCATED( surf_def_v(l)%rib ) ) & 3258 surf_v(l)%rib(mm(l)) = surf_def_v(l)%rib(m) 3259 IF ( ALLOCATED( surf_def_v(l)%pt_surface ) ) & 3260 surf_v(l)%pt_surface(mm(l)) = surf_def_v(l)%pt_surface(m) 3261 IF ( ALLOCATED( surf_def_v(l)%q_surface ) ) & 3262 surf_v(l)%q_surface(mm(l)) = surf_def_v(l)%q_surface(m) 3263 IF ( ALLOCATED( surf_def_v(l)%vpt_surface ) ) & 3264 surf_v(l)%vpt_surface(mm(l)) = surf_def_v(l)%vpt_surface(m) 3265 IF ( ALLOCATED( surf_def_v(l)%shf ) ) & 3266 surf_v(l)%shf(mm(l)) = surf_def_v(l)%shf(m) 3267 IF ( ALLOCATED( surf_def_v(l)%qsws ) ) & 3268 surf_v(l)%qsws(mm(l)) = surf_def_v(l)%qsws(m) 3269 IF ( ALLOCATED( surf_def_v(l)%ssws ) ) & 3270 surf_v(l)%ssws(mm(l)) = surf_def_v(l)%ssws(m) 3271 IF ( ALLOCATED( surf_def_v(l)%css ) ) THEN 3272 DO lsp = 1, nvar 3273 surf_v(l)%css(lsp,mm(l)) = surf_def_v(l)%css(lsp,m) 3353 3274 ENDDO 3354 3275 ENDIF 3355 3356 start_index_h(l) = surf_h(l)%end_index(j,i) + 1 3357 3276 IF ( ALLOCATED( surf_def_v(l)%cssws ) ) THEN 3277 DO lsp = 1, nvar 3278 surf_v(l)%cssws(lsp,mm(l)) = surf_def_v(l)%cssws(lsp,m) 3279 ENDDO 3280 ENDIF 3281 IF ( ALLOCATED( surf_def_v(l)%qcsws ) ) & 3282 surf_v(l)%qcsws(mm(l)) = surf_def_v(l)%qcsws(m) 3283 IF ( ALLOCATED( surf_def_v(l)%qisws ) ) & 3284 surf_v(l)%qisws(mm(l)) = surf_def_v(l)%qisws(m) 3285 IF ( ALLOCATED( surf_def_v(l)%qrsws ) ) & 3286 surf_v(l)%qrsws(mm(l)) = surf_def_v(l)%qrsws(m) 3287 IF ( ALLOCATED( surf_def_v(l)%ncsws ) ) & 3288 surf_v(l)%ncsws(mm(l)) = surf_def_v(l)%ncsws(m) 3289 IF ( ALLOCATED( surf_def_v(l)%nisws ) ) & 3290 surf_v(l)%nisws(mm(l)) = surf_def_v(l)%nisws(m) 3291 IF ( ALLOCATED( surf_def_v(l)%nrsws ) ) & 3292 surf_v(l)%nrsws(mm(l)) = surf_def_v(l)%nrsws(m) 3293 IF ( ALLOCATED( surf_def_v(l)%sasws ) ) & 3294 surf_v(l)%sasws(mm(l)) = surf_def_v(l)%sasws(m) 3295 IF ( ALLOCATED( surf_def_v(l)%mom_flux_uv) ) & 3296 surf_v(l)%mom_flux_uv(mm(l)) = surf_def_v(l)%mom_flux_uv(m) 3297 IF ( ALLOCATED( surf_def_v(l)%mom_flux_w) ) & 3298 surf_v(l)%mom_flux_w(mm(l)) = surf_def_v(l)%mom_flux_w(m) 3299 IF ( ALLOCATED( surf_def_v(l)%mom_flux_tke) ) & 3300 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_def_v(l)%mom_flux_tke(0:1,m) 3301 3302 mm(l) = mm(l) + 1 3358 3303 ENDDO 3304 3305 DO m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i) 3306 IF ( ALLOCATED( surf_lsm_v(l)%us ) ) & 3307 surf_v(l)%us(mm(l)) = surf_lsm_v(l)%us(m) 3308 IF ( ALLOCATED( surf_lsm_v(l)%ts ) ) & 3309 surf_v(l)%ts(mm(l)) = surf_lsm_v(l)%ts(m) 3310 IF ( ALLOCATED( surf_lsm_v(l)%qs ) ) & 3311 surf_v(l)%qs(mm(l)) = surf_lsm_v(l)%qs(m) 3312 IF ( ALLOCATED( surf_lsm_v(l)%ss ) ) & 3313 surf_v(l)%ss(mm(l)) = surf_lsm_v(l)%ss(m) 3314 IF ( ALLOCATED( surf_lsm_v(l)%qcs ) ) & 3315 surf_v(l)%qcs(mm(l)) = surf_lsm_v(l)%qcs(m) 3316 IF ( ALLOCATED( surf_lsm_v(l)%ncs ) ) & 3317 surf_v(l)%ncs(mm(l)) = surf_lsm_v(l)%ncs(m) 3318 IF ( ALLOCATED( surf_lsm_v(l)%qis ) ) & 3319 surf_v(l)%qis(mm(l)) = surf_lsm_v(l)%qis(m) 3320 IF ( ALLOCATED( surf_lsm_v(l)%nis ) ) & 3321 surf_v(l)%nis(mm(l)) = surf_lsm_v(l)%nis(m) 3322 IF ( ALLOCATED( surf_lsm_v(l)%qrs ) ) & 3323 surf_v(l)%qrs(mm(l)) = surf_lsm_v(l)%qrs(m) 3324 IF ( ALLOCATED( surf_lsm_v(l)%nrs ) ) & 3325 surf_v(l)%nrs(mm(l)) = surf_lsm_v(l)%nrs(m) 3326 IF ( ALLOCATED( surf_lsm_v(l)%ol ) ) & 3327 surf_v(l)%ol(mm(l)) = surf_lsm_v(l)%ol(m) 3328 IF ( ALLOCATED( surf_lsm_v(l)%rib ) ) & 3329 surf_v(l)%rib(mm(l)) = surf_lsm_v(l)%rib(m) 3330 IF ( ALLOCATED( surf_lsm_v(l)%pt_surface ) ) & 3331 surf_v(l)%pt_surface(mm(l)) = surf_lsm_v(l)%pt_surface(m) 3332 IF ( ALLOCATED( surf_lsm_v(l)%q_surface ) ) & 3333 surf_v(l)%q_surface(mm(l)) = surf_lsm_v(l)%q_surface(m) 3334 IF ( ALLOCATED( surf_lsm_v(l)%vpt_surface ) ) & 3335 surf_v(l)%vpt_surface(mm(l)) = surf_lsm_v(l)%vpt_surface(m) 3336 IF ( ALLOCATED( surf_lsm_v(l)%usws ) ) & 3337 surf_v(l)%usws(mm(l)) = surf_lsm_v(l)%usws(m) 3338 IF ( ALLOCATED( surf_lsm_v(l)%vsws ) ) & 3339 surf_v(l)%vsws(mm(l)) = surf_lsm_v(l)%vsws(m) 3340 IF ( ALLOCATED( surf_lsm_v(l)%shf ) ) & 3341 surf_v(l)%shf(mm(l)) = surf_lsm_v(l)%shf(m) 3342 IF ( ALLOCATED( surf_lsm_v(l)%qsws ) ) & 3343 surf_v(l)%qsws(mm(l)) = surf_lsm_v(l)%qsws(m) 3344 IF ( ALLOCATED( surf_lsm_v(l)%ssws ) ) & 3345 surf_v(l)%ssws(mm(l)) = surf_lsm_v(l)%ssws(m) 3346 IF ( ALLOCATED( surf_lsm_v(l)%css ) ) THEN 3347 DO lsp = 1, nvar 3348 surf_v(l)%css(lsp,mm(l)) = surf_lsm_v(l)%css(lsp,m) 3349 ENDDO 3350 ENDIF 3351 IF ( ALLOCATED( surf_lsm_v(l)%cssws ) ) THEN 3352 DO lsp = 1, nvar 3353 surf_v(l)%cssws(lsp,mm(l)) = surf_lsm_v(l)%cssws(lsp,m) 3354 ENDDO 3355 ENDIF 3356 IF ( ALLOCATED( surf_lsm_v(l)%qcsws ) ) & 3357 surf_v(l)%qcsws(mm(l)) = surf_lsm_v(l)%qcsws(m) 3358 IF ( ALLOCATED( surf_lsm_v(l)%qrsws ) ) & 3359 surf_v(l)%qrsws(mm(l)) = surf_lsm_v(l)%qrsws(m) 3360 IF ( ALLOCATED( surf_lsm_v(l)%qisws ) ) & 3361 surf_v(l)%qisws(mm(l)) = surf_lsm_v(l)%qisws(m) 3362 IF ( ALLOCATED( surf_lsm_v(l)%ncsws ) ) & 3363 surf_v(l)%ncsws(mm(l)) = surf_lsm_v(l)%ncsws(m) 3364 IF ( ALLOCATED( surf_lsm_v(l)%nisws ) ) & 3365 surf_v(l)%nisws(mm(l)) = surf_lsm_v(l)%nisws(m) 3366 IF ( ALLOCATED( surf_lsm_v(l)%nrsws ) ) & 3367 surf_v(l)%nrsws(mm(l)) = surf_lsm_v(l)%nrsws(m) 3368 IF ( ALLOCATED( surf_lsm_v(l)%sasws ) ) & 3369 surf_v(l)%sasws(mm(l)) = surf_lsm_v(l)%sasws(m) 3370 IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_uv) ) & 3371 surf_v(l)%mom_flux_uv(mm(l)) = surf_lsm_v(l)%mom_flux_uv(m) 3372 IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_w) ) & 3373 surf_v(l)%mom_flux_w(mm(l)) = surf_lsm_v(l)%mom_flux_w(m) 3374 IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_tke) ) & 3375 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_lsm_v(l)%mom_flux_tke(0:1,m) 3376 3377 mm(l) = mm(l) + 1 3378 ENDDO 3379 3380 DO m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i) 3381 IF ( ALLOCATED( surf_usm_v(l)%us ) ) & 3382 surf_v(l)%us(mm(l)) = surf_usm_v(l)%us(m) 3383 IF ( ALLOCATED( surf_usm_v(l)%ts ) ) & 3384 surf_v(l)%ts(mm(l)) = surf_usm_v(l)%ts(m) 3385 IF ( ALLOCATED( surf_usm_v(l)%qs ) ) & 3386 surf_v(l)%qs(mm(l)) = surf_usm_v(l)%qs(m) 3387 IF ( ALLOCATED( surf_usm_v(l)%ss ) ) & 3388 surf_v(l)%ss(mm(l)) = surf_usm_v(l)%ss(m) 3389 IF ( ALLOCATED( surf_usm_v(l)%qcs ) ) & 3390 surf_v(l)%qcs(mm(l)) = surf_usm_v(l)%qcs(m) 3391 IF ( ALLOCATED( surf_usm_v(l)%ncs ) ) & 3392 surf_v(l)%ncs(mm(l)) = surf_usm_v(l)%ncs(m) 3393 IF ( ALLOCATED( surf_usm_v(l)%qis ) ) & 3394 surf_v(l)%qis(mm(l)) = surf_usm_v(l)%qis(m) 3395 IF ( ALLOCATED( surf_usm_v(l)%nis ) ) & 3396 surf_v(l)%nis(mm(l)) = surf_usm_v(l)%nis(m) 3397 IF ( ALLOCATED( surf_usm_v(l)%qrs ) ) & 3398 surf_v(l)%qrs(mm(l)) = surf_usm_v(l)%qrs(m) 3399 IF ( ALLOCATED( surf_usm_v(l)%nrs ) ) & 3400 surf_v(l)%nrs(mm(l)) = surf_usm_v(l)%nrs(m) 3401 IF ( ALLOCATED( surf_usm_v(l)%ol ) ) & 3402 surf_v(l)%ol(mm(l)) = surf_usm_v(l)%ol(m) 3403 IF ( ALLOCATED( surf_usm_v(l)%rib ) ) & 3404 surf_v(l)%rib(mm(l)) = surf_usm_v(l)%rib(m) 3405 IF ( ALLOCATED( surf_usm_v(l)%pt_surface ) ) & 3406 surf_v(l)%pt_surface(mm(l)) = surf_usm_v(l)%pt_surface(m) 3407 IF ( ALLOCATED( surf_usm_v(l)%q_surface ) ) & 3408 surf_v(l)%q_surface(mm(l)) = surf_usm_v(l)%q_surface(m) 3409 IF ( ALLOCATED( surf_usm_v(l)%vpt_surface ) ) & 3410 surf_v(l)%vpt_surface(mm(l)) = surf_usm_v(l)%vpt_surface(m) 3411 IF ( ALLOCATED( surf_usm_v(l)%usws ) ) & 3412 surf_v(l)%usws(mm(l)) = surf_usm_v(l)%usws(m) 3413 IF ( ALLOCATED( surf_usm_v(l)%vsws ) ) & 3414 surf_v(l)%vsws(mm(l)) = surf_usm_v(l)%vsws(m) 3415 IF ( ALLOCATED( surf_usm_v(l)%shf ) ) & 3416 surf_v(l)%shf(mm(l)) = surf_usm_v(l)%shf(m) 3417 IF ( ALLOCATED( surf_usm_v(l)%qsws ) ) & 3418 surf_v(l)%qsws(mm(l)) = surf_usm_v(l)%qsws(m) 3419 IF ( ALLOCATED( surf_usm_v(l)%ssws ) ) & 3420 surf_v(l)%ssws(mm(l)) = surf_usm_v(l)%ssws(m) 3421 IF ( ALLOCATED( surf_usm_v(l)%css ) ) THEN 3422 DO lsp = 1, nvar 3423 surf_v(l)%css(lsp,mm(l)) = surf_usm_v(l)%css(lsp,m) 3424 ENDDO 3425 ENDIF 3426 IF ( ALLOCATED( surf_usm_v(l)%cssws ) ) THEN 3427 DO lsp = 1, nvar 3428 surf_v(l)%cssws(lsp,mm(l)) = surf_usm_v(l)%cssws(lsp,m) 3429 ENDDO 3430 ENDIF 3431 IF ( ALLOCATED( surf_usm_v(l)%qcsws ) ) & 3432 surf_v(l)%qcsws(mm(l)) = surf_usm_v(l)%qcsws(m) 3433 IF ( ALLOCATED( surf_usm_v(l)%qrsws ) ) & 3434 surf_v(l)%qrsws(mm(l)) = surf_usm_v(l)%qrsws(m) 3435 IF ( ALLOCATED( surf_usm_v(l)%qisws ) ) & 3436 surf_v(l)%qisws(mm(l)) = surf_usm_v(l)%qisws(m) 3437 IF ( ALLOCATED( surf_usm_v(l)%ncsws ) ) & 3438 surf_v(l)%ncsws(mm(l)) = surf_usm_v(l)%ncsws(m) 3439 IF ( ALLOCATED( surf_usm_v(l)%nisws ) ) & 3440 surf_v(l)%nisws(mm(l)) = surf_usm_v(l)%nisws(m) 3441 IF ( ALLOCATED( surf_usm_v(l)%nrsws ) ) & 3442 surf_v(l)%nrsws(mm(l)) = surf_usm_v(l)%nrsws(m) 3443 IF ( ALLOCATED( surf_usm_v(l)%sasws ) ) & 3444 surf_v(l)%sasws(mm(l)) = surf_usm_v(l)%sasws(m) 3445 IF ( ALLOCATED( surf_usm_v(l)%mom_flux_uv) ) & 3446 surf_v(l)%mom_flux_uv(mm(l)) = surf_usm_v(l)%mom_flux_uv(m) 3447 IF ( ALLOCATED( surf_usm_v(l)%mom_flux_w) ) & 3448 surf_v(l)%mom_flux_w(mm(l)) = surf_usm_v(l)%mom_flux_w(m) 3449 IF ( ALLOCATED( surf_usm_v(l)%mom_flux_tke) ) & 3450 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_usm_v(l)%mom_flux_tke(0:1,m) 3451 3452 mm(l) = mm(l) + 1 3453 ENDDO 3454 3359 3455 ENDDO 3360 3456 ENDDO 3361 3457 ! 3362 !-- Treat vertically orientated surface. Again, gather data from different 3363 !-- surfaces types but identical orientation (e.g. northward-facing) onto 3364 !-- one surface type which is output afterwards. 3365 mm(0:3) = 1 3458 !-- Recalculate start- and end-indices for gathered surface type 3459 start_index_v(l) = 1 3460 DO i = nxl, nxr 3461 DO j = nys, nyn 3462 3463 surf_v(l)%start_index(j,i) = start_index_v(l) 3464 surf_v(l)%end_index(j,i) = surf_v(l)%start_index(j,i) -1 3465 3466 DO m = surf_def_v(l)%start_index(j,i), surf_def_v(l)%end_index(j,i) 3467 surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1 3468 ENDDO 3469 DO m = surf_lsm_v(l)%start_index(j,i), surf_lsm_v(l)%end_index(j,i) 3470 surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1 3471 ENDDO 3472 DO m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i) 3473 surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1 3474 ENDDO 3475 3476 start_index_v(l) = surf_v(l)%end_index(j,i) + 1 3477 ENDDO 3478 ENDDO 3479 3480 ENDDO 3481 3482 ! 3483 !-- Now start writing restart data to file 3484 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 3485 3486 ! 3487 !-- Output strings for the total number of upward / downward-facing surfaces on subdomain. 3488 CALL wrd_write_string( 'ns_h_on_file' ) 3489 WRITE ( 14 ) ns_h_on_file 3490 ! 3491 !-- Output strings for the total number of north/south/east/westward-facing surfaces on subdomain. 3492 CALL wrd_write_string( 'ns_v_on_file' ) 3493 WRITE ( 14 ) ns_v_on_file 3494 3495 ! 3496 !-- Horizontal surfaces (upward-, downward-facing, and model top). 3497 !-- Always start with %start_index followed by %end_index 3498 DO l = 0, 2 3499 WRITE( dum, '(I1)') l 3500 3501 CALL wrd_write_string( 'surf_h(' // dum // ')%start_index' ) 3502 WRITE ( 14 ) surf_h(l)%start_index 3503 3504 CALL wrd_write_string( 'surf_h(' // dum // ')%end_index' ) 3505 WRITE ( 14 ) surf_h(l)%end_index 3506 3507 IF ( ALLOCATED ( surf_h(l)%us ) ) THEN 3508 CALL wrd_write_string( 'surf_h(' // dum // ')%us' ) 3509 WRITE ( 14 ) surf_h(l)%us 3510 ENDIF 3511 3512 IF ( ALLOCATED ( surf_h(l)%ts ) ) THEN 3513 CALL wrd_write_string( 'surf_h(' // dum // ')%ts' ) 3514 WRITE ( 14 ) surf_h(l)%ts 3515 ENDIF 3516 3517 IF ( ALLOCATED ( surf_h(l)%qs ) ) THEN 3518 CALL wrd_write_string( 'surf_h(' // dum // ')%qs' ) 3519 WRITE ( 14 ) surf_h(l)%qs 3520 ENDIF 3521 3522 IF ( ALLOCATED ( surf_h(l)%ss ) ) THEN 3523 CALL wrd_write_string( 'surf_h(' // dum // ')%ss' ) 3524 WRITE ( 14 ) surf_h(l)%ss 3525 ENDIF 3526 3527 IF ( ALLOCATED ( surf_h(l)%qcs ) ) THEN 3528 CALL wrd_write_string( 'surf_h(' // dum // ')%qcs' ) 3529 WRITE ( 14 ) surf_h(l)%qcs 3530 ENDIF 3531 3532 IF ( ALLOCATED ( surf_h(l)%ncs ) ) THEN 3533 CALL wrd_write_string( 'surf_h(' // dum // ')%ncs' ) 3534 WRITE ( 14 ) surf_h(l)%ncs 3535 ENDIF 3536 3537 IF ( ALLOCATED ( surf_h(l)%qis ) ) THEN 3538 CALL wrd_write_string( 'surf_h(' // dum // ')%qis' ) 3539 WRITE ( 14 ) surf_h(l)%qis 3540 ENDIF 3541 3542 IF ( ALLOCATED ( surf_h(l)%nis ) ) THEN 3543 CALL wrd_write_string( 'surf_h(' // dum // ')%nis' ) 3544 WRITE ( 14 ) surf_h(l)%nis 3545 ENDIF 3546 3547 IF ( ALLOCATED ( surf_h(l)%qrs ) ) THEN 3548 CALL wrd_write_string( 'surf_h(' // dum // ')%qrs' ) 3549 WRITE ( 14 ) surf_h(l)%qrs 3550 ENDIF 3551 3552 IF ( ALLOCATED ( surf_h(l)%nrs ) ) THEN 3553 CALL wrd_write_string( 'surf_h(' // dum // ')%nrs' ) 3554 WRITE ( 14 ) surf_h(l)%nrs 3555 ENDIF 3556 3557 IF ( ALLOCATED ( surf_h(l)%ol ) ) THEN 3558 CALL wrd_write_string( 'surf_h(' // dum // ')%ol' ) 3559 WRITE ( 14 ) surf_h(l)%ol 3560 ENDIF 3561 3562 IF ( ALLOCATED ( surf_h(l)%rib ) ) THEN 3563 CALL wrd_write_string( 'surf_h(' // dum // ')%rib' ) 3564 WRITE ( 14 ) surf_h(l)%rib 3565 ENDIF 3566 3567 IF ( ALLOCATED ( surf_h(l)%pt_surface ) ) THEN 3568 CALL wrd_write_string( 'surf_h(' // dum // ')%pt_surface' ) 3569 WRITE ( 14 ) surf_h(l)%pt_surface 3570 ENDIF 3571 3572 IF ( ALLOCATED ( surf_h(l)%q_surface ) ) THEN 3573 CALL wrd_write_string( 'surf_h(' // dum // ')%q_surface' ) 3574 WRITE ( 14 ) surf_h(l)%q_surface 3575 ENDIF 3576 3577 IF ( ALLOCATED ( surf_h(l)%vpt_surface ) ) THEN 3578 CALL wrd_write_string( 'surf_h(' // dum // ')%vpt_surface' ) 3579 WRITE ( 14 ) surf_h(l)%vpt_surface 3580 ENDIF 3581 3582 IF ( ALLOCATED ( surf_h(l)%usws ) ) THEN 3583 CALL wrd_write_string( 'surf_h(' // dum // ')%usws' ) 3584 WRITE ( 14 ) surf_h(l)%usws 3585 ENDIF 3586 3587 IF ( ALLOCATED ( surf_h(l)%vsws ) ) THEN 3588 CALL wrd_write_string( 'surf_h(' // dum // ')%vsws' ) 3589 WRITE ( 14 ) surf_h(l)%vsws 3590 ENDIF 3591 3592 IF ( ALLOCATED ( surf_h(l)%shf ) ) THEN 3593 CALL wrd_write_string( 'surf_h(' // dum // ')%shf' ) 3594 WRITE ( 14 ) surf_h(l)%shf 3595 ENDIF 3596 3597 IF ( ALLOCATED ( surf_h(l)%qsws ) ) THEN 3598 CALL wrd_write_string( 'surf_h(' // dum // ')%qsws' ) 3599 WRITE ( 14 ) surf_h(l)%qsws 3600 ENDIF 3601 3602 IF ( ALLOCATED ( surf_h(l)%ssws ) ) THEN 3603 CALL wrd_write_string( 'surf_h(' // dum // ')%ssws' ) 3604 WRITE ( 14 ) surf_h(l)%ssws 3605 ENDIF 3606 3607 IF ( ALLOCATED ( surf_h(l)%css ) ) THEN 3608 CALL wrd_write_string( 'surf_h(' // dum // ')%css' ) 3609 WRITE ( 14 ) surf_h(l)%css 3610 ENDIF 3611 3612 IF ( ALLOCATED ( surf_h(l)%cssws ) ) THEN 3613 CALL wrd_write_string( 'surf_h(' // dum // ')%cssws' ) 3614 WRITE ( 14 ) surf_h(l)%cssws 3615 ENDIF 3616 3617 IF ( ALLOCATED ( surf_h(l)%qcsws ) ) THEN 3618 CALL wrd_write_string( 'surf_h(' // dum // ')%qcsws' ) 3619 WRITE ( 14 ) surf_h(l)%qcsws 3620 ENDIF 3621 3622 IF ( ALLOCATED ( surf_h(l)%ncsws ) ) THEN 3623 CALL wrd_write_string( 'surf_h(' // dum // ')%ncsws' ) 3624 WRITE ( 14 ) surf_h(l)%ncsws 3625 ENDIF 3626 3627 IF ( ALLOCATED ( surf_h(l)%qisws ) ) THEN 3628 CALL wrd_write_string( 'surf_h(' // dum // ')%qisws' ) 3629 WRITE ( 14 ) surf_h(l)%qisws 3630 ENDIF 3631 3632 IF ( ALLOCATED ( surf_h(l)%nisws ) ) THEN 3633 CALL wrd_write_string( 'surf_h(' // dum // ')%nisws' ) 3634 WRITE ( 14 ) surf_h(l)%nisws 3635 ENDIF 3636 3637 IF ( ALLOCATED ( surf_h(l)%qrsws ) ) THEN 3638 CALL wrd_write_string( 'surf_h(' // dum // ')%qrsws' ) 3639 WRITE ( 14 ) surf_h(l)%qrsws 3640 ENDIF 3641 3642 IF ( ALLOCATED ( surf_h(l)%nrsws ) ) THEN 3643 CALL wrd_write_string( 'surf_h(' // dum // ')%nrsws' ) 3644 WRITE ( 14 ) surf_h(l)%nrsws 3645 ENDIF 3646 3647 IF ( ALLOCATED ( surf_h(l)%sasws ) ) THEN 3648 CALL wrd_write_string( 'surf_h(' // dum // ')%sasws' ) 3649 WRITE ( 14 ) surf_h(l)%sasws 3650 ENDIF 3651 3652 ENDDO 3653 ! 3654 !-- Write vertical surfaces. 3655 !-- Always start with %start_index followed by %end_index. 3366 3656 DO l = 0, 3 3367 DO i = nxl, nxr 3368 DO j = nys, nyn 3369 DO m = surf_def_v(l)%start_index(j,i), & 3370 surf_def_v(l)%end_index(j,i) 3371 IF ( ALLOCATED( surf_def_v(l)%us ) ) & 3372 surf_v(l)%us(mm(l)) = surf_def_v(l)%us(m) 3373 IF ( ALLOCATED( surf_def_v(l)%ts ) ) & 3374 surf_v(l)%ts(mm(l)) = surf_def_v(l)%ts(m) 3375 IF ( ALLOCATED( surf_def_v(l)%qs ) ) & 3376 surf_v(l)%qs(mm(l)) = surf_def_v(l)%qs(m) 3377 IF ( ALLOCATED( surf_def_v(l)%ss ) ) & 3378 surf_v(l)%ss(mm(l)) = surf_def_v(l)%ss(m) 3379 IF ( ALLOCATED( surf_def_v(l)%qcs ) ) & 3380 surf_v(l)%qcs(mm(l)) = surf_def_v(l)%qcs(m) 3381 IF ( ALLOCATED( surf_def_v(l)%ncs ) ) & 3382 surf_v(l)%ncs(mm(l)) = surf_def_v(l)%ncs(m) 3383 IF ( ALLOCATED( surf_def_v(l)%qis ) ) & 3384 surf_v(l)%qis(mm(l)) = surf_def_v(l)%qis(m) 3385 IF ( ALLOCATED( surf_def_v(l)%nis ) ) & 3386 surf_v(l)%nis(mm(l)) = surf_def_v(l)%nis(m) 3387 IF ( ALLOCATED( surf_def_v(l)%qrs ) ) & 3388 surf_v(l)%qrs(mm(l)) = surf_def_v(l)%qrs(m) 3389 IF ( ALLOCATED( surf_def_v(l)%nrs ) ) & 3390 surf_v(l)%nrs(mm(l)) = surf_def_v(l)%nrs(m) 3391 IF ( ALLOCATED( surf_def_v(l)%ol ) ) & 3392 surf_v(l)%ol(mm(l)) = surf_def_v(l)%ol(m) 3393 IF ( ALLOCATED( surf_def_v(l)%rib ) ) & 3394 surf_v(l)%rib(mm(l)) = surf_def_v(l)%rib(m) 3395 IF ( ALLOCATED( surf_def_v(l)%pt_surface ) ) & 3396 surf_v(l)%pt_surface(mm(l)) = surf_def_v(l)%pt_surface(m) 3397 IF ( ALLOCATED( surf_def_v(l)%q_surface ) ) & 3398 surf_v(l)%q_surface(mm(l)) = surf_def_v(l)%q_surface(m) 3399 IF ( ALLOCATED( surf_def_v(l)%vpt_surface ) ) & 3400 surf_v(l)%vpt_surface(mm(l)) = surf_def_v(l)%vpt_surface(m) 3401 IF ( ALLOCATED( surf_def_v(l)%shf ) ) & 3402 surf_v(l)%shf(mm(l)) = surf_def_v(l)%shf(m) 3403 IF ( ALLOCATED( surf_def_v(l)%qsws ) ) & 3404 surf_v(l)%qsws(mm(l)) = surf_def_v(l)%qsws(m) 3405 IF ( ALLOCATED( surf_def_v(l)%ssws ) ) & 3406 surf_v(l)%ssws(mm(l)) = surf_def_v(l)%ssws(m) 3407 IF ( ALLOCATED( surf_def_v(l)%css ) ) THEN 3408 DO lsp = 1, nvar 3409 surf_v(l)%css(lsp,mm(l)) = surf_def_v(l)%css(lsp,m) 3410 ENDDO 3411 ENDIF 3412 IF ( ALLOCATED( surf_def_v(l)%cssws ) ) THEN 3413 DO lsp = 1, nvar 3414 surf_v(l)%cssws(lsp,mm(l)) = surf_def_v(l)%cssws(lsp,m) 3415 ENDDO 3416 ENDIF 3417 IF ( ALLOCATED( surf_def_v(l)%qcsws ) ) & 3418 surf_v(l)%qcsws(mm(l)) = surf_def_v(l)%qcsws(m) 3419 IF ( ALLOCATED( surf_def_v(l)%qisws ) ) & 3420 surf_v(l)%qisws(mm(l)) = surf_def_v(l)%qisws(m) 3421 IF ( ALLOCATED( surf_def_v(l)%qrsws ) ) & 3422 surf_v(l)%qrsws(mm(l)) = surf_def_v(l)%qrsws(m) 3423 IF ( ALLOCATED( surf_def_v(l)%ncsws ) ) & 3424 surf_v(l)%ncsws(mm(l)) = surf_def_v(l)%ncsws(m) 3425 IF ( ALLOCATED( surf_def_v(l)%nisws ) ) & 3426 surf_v(l)%nisws(mm(l)) = surf_def_v(l)%nisws(m) 3427 IF ( ALLOCATED( surf_def_v(l)%nrsws ) ) & 3428 surf_v(l)%nrsws(mm(l)) = surf_def_v(l)%nrsws(m) 3429 IF ( ALLOCATED( surf_def_v(l)%sasws ) ) & 3430 surf_v(l)%sasws(mm(l)) = surf_def_v(l)%sasws(m) 3431 IF ( ALLOCATED( surf_def_v(l)%mom_flux_uv) ) & 3432 surf_v(l)%mom_flux_uv(mm(l)) = surf_def_v(l)%mom_flux_uv(m) 3433 IF ( ALLOCATED( surf_def_v(l)%mom_flux_w) ) & 3434 surf_v(l)%mom_flux_w(mm(l)) = surf_def_v(l)%mom_flux_w(m) 3435 IF ( ALLOCATED( surf_def_v(l)%mom_flux_tke) ) & 3436 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_def_v(l)%mom_flux_tke(0:1,m) 3437 3438 mm(l) = mm(l) + 1 3439 ENDDO 3440 3441 DO m = surf_lsm_v(l)%start_index(j,i), & 3442 surf_lsm_v(l)%end_index(j,i) 3443 IF ( ALLOCATED( surf_lsm_v(l)%us ) ) & 3444 surf_v(l)%us(mm(l)) = surf_lsm_v(l)%us(m) 3445 IF ( ALLOCATED( surf_lsm_v(l)%ts ) ) & 3446 surf_v(l)%ts(mm(l)) = surf_lsm_v(l)%ts(m) 3447 IF ( ALLOCATED( surf_lsm_v(l)%qs ) ) & 3448 surf_v(l)%qs(mm(l)) = surf_lsm_v(l)%qs(m) 3449 IF ( ALLOCATED( surf_lsm_v(l)%ss ) ) & 3450 surf_v(l)%ss(mm(l)) = surf_lsm_v(l)%ss(m) 3451 IF ( ALLOCATED( surf_lsm_v(l)%qcs ) ) & 3452 surf_v(l)%qcs(mm(l)) = surf_lsm_v(l)%qcs(m) 3453 IF ( ALLOCATED( surf_lsm_v(l)%ncs ) ) & 3454 surf_v(l)%ncs(mm(l)) = surf_lsm_v(l)%ncs(m) 3455 IF ( ALLOCATED( surf_lsm_v(l)%qis ) ) & 3456 surf_v(l)%qis(mm(l)) = surf_lsm_v(l)%qis(m) 3457 IF ( ALLOCATED( surf_lsm_v(l)%nis ) ) & 3458 surf_v(l)%nis(mm(l)) = surf_lsm_v(l)%nis(m) 3459 IF ( ALLOCATED( surf_lsm_v(l)%qrs ) ) & 3460 surf_v(l)%qrs(mm(l)) = surf_lsm_v(l)%qrs(m) 3461 IF ( ALLOCATED( surf_lsm_v(l)%nrs ) ) & 3462 surf_v(l)%nrs(mm(l)) = surf_lsm_v(l)%nrs(m) 3463 IF ( ALLOCATED( surf_lsm_v(l)%ol ) ) & 3464 surf_v(l)%ol(mm(l)) = surf_lsm_v(l)%ol(m) 3465 IF ( ALLOCATED( surf_lsm_v(l)%rib ) ) & 3466 surf_v(l)%rib(mm(l)) = surf_lsm_v(l)%rib(m) 3467 IF ( ALLOCATED( surf_lsm_v(l)%pt_surface ) ) & 3468 surf_v(l)%pt_surface(mm(l)) = surf_lsm_v(l)%pt_surface(m) 3469 IF ( ALLOCATED( surf_lsm_v(l)%q_surface ) ) & 3470 surf_v(l)%q_surface(mm(l)) = surf_lsm_v(l)%q_surface(m) 3471 IF ( ALLOCATED( surf_lsm_v(l)%vpt_surface ) ) & 3472 surf_v(l)%vpt_surface(mm(l)) = surf_lsm_v(l)%vpt_surface(m) 3473 IF ( ALLOCATED( surf_lsm_v(l)%usws ) ) & 3474 surf_v(l)%usws(mm(l)) = surf_lsm_v(l)%usws(m) 3475 IF ( ALLOCATED( surf_lsm_v(l)%vsws ) ) & 3476 surf_v(l)%vsws(mm(l)) = surf_lsm_v(l)%vsws(m) 3477 IF ( ALLOCATED( surf_lsm_v(l)%shf ) ) & 3478 surf_v(l)%shf(mm(l)) = surf_lsm_v(l)%shf(m) 3479 IF ( ALLOCATED( surf_lsm_v(l)%qsws ) ) & 3480 surf_v(l)%qsws(mm(l)) = surf_lsm_v(l)%qsws(m) 3481 IF ( ALLOCATED( surf_lsm_v(l)%ssws ) ) & 3482 surf_v(l)%ssws(mm(l)) = surf_lsm_v(l)%ssws(m) 3483 IF ( ALLOCATED( surf_lsm_v(l)%css ) ) THEN 3484 DO lsp = 1, nvar 3485 surf_v(l)%css(lsp,mm(l)) = surf_lsm_v(l)%css(lsp,m) 3486 ENDDO 3487 ENDIF 3488 IF ( ALLOCATED( surf_lsm_v(l)%cssws ) ) THEN 3489 DO lsp = 1, nvar 3490 surf_v(l)%cssws(lsp,mm(l)) = surf_lsm_v(l)%cssws(lsp,m) 3491 ENDDO 3492 ENDIF 3493 IF ( ALLOCATED( surf_lsm_v(l)%qcsws ) ) & 3494 surf_v(l)%qcsws(mm(l)) = surf_lsm_v(l)%qcsws(m) 3495 IF ( ALLOCATED( surf_lsm_v(l)%qrsws ) ) & 3496 surf_v(l)%qrsws(mm(l)) = surf_lsm_v(l)%qrsws(m) 3497 IF ( ALLOCATED( surf_lsm_v(l)%qisws ) ) & 3498 surf_v(l)%qisws(mm(l)) = surf_lsm_v(l)%qisws(m) 3499 IF ( ALLOCATED( surf_lsm_v(l)%ncsws ) ) & 3500 surf_v(l)%ncsws(mm(l)) = surf_lsm_v(l)%ncsws(m) 3501 IF ( ALLOCATED( surf_lsm_v(l)%nisws ) ) & 3502 surf_v(l)%nisws(mm(l)) = surf_lsm_v(l)%nisws(m) 3503 IF ( ALLOCATED( surf_lsm_v(l)%nrsws ) ) & 3504 surf_v(l)%nrsws(mm(l)) = surf_lsm_v(l)%nrsws(m) 3505 IF ( ALLOCATED( surf_lsm_v(l)%sasws ) ) & 3506 surf_v(l)%sasws(mm(l)) = surf_lsm_v(l)%sasws(m) 3507 IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_uv) ) & 3508 surf_v(l)%mom_flux_uv(mm(l)) = surf_lsm_v(l)%mom_flux_uv(m) 3509 IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_w) ) & 3510 surf_v(l)%mom_flux_w(mm(l)) = surf_lsm_v(l)%mom_flux_w(m) 3511 IF ( ALLOCATED( surf_lsm_v(l)%mom_flux_tke) ) & 3512 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_lsm_v(l)%mom_flux_tke(0:1,m) 3513 3514 mm(l) = mm(l) + 1 3515 ENDDO 3516 3517 DO m = surf_usm_v(l)%start_index(j,i), & 3518 surf_usm_v(l)%end_index(j,i) 3519 IF ( ALLOCATED( surf_usm_v(l)%us ) ) & 3520 surf_v(l)%us(mm(l)) = surf_usm_v(l)%us(m) 3521 IF ( ALLOCATED( surf_usm_v(l)%ts ) ) & 3522 surf_v(l)%ts(mm(l)) = surf_usm_v(l)%ts(m) 3523 IF ( ALLOCATED( surf_usm_v(l)%qs ) ) & 3524 surf_v(l)%qs(mm(l)) = surf_usm_v(l)%qs(m) 3525 IF ( ALLOCATED( surf_usm_v(l)%ss ) ) & 3526 surf_v(l)%ss(mm(l)) = surf_usm_v(l)%ss(m) 3527 IF ( ALLOCATED( surf_usm_v(l)%qcs ) ) & 3528 surf_v(l)%qcs(mm(l)) = surf_usm_v(l)%qcs(m) 3529 IF ( ALLOCATED( surf_usm_v(l)%ncs ) ) & 3530 surf_v(l)%ncs(mm(l)) = surf_usm_v(l)%ncs(m) 3531 IF ( ALLOCATED( surf_usm_v(l)%qis ) ) & 3532 surf_v(l)%qis(mm(l)) = surf_usm_v(l)%qis(m) 3533 IF ( ALLOCATED( surf_usm_v(l)%nis ) ) & 3534 surf_v(l)%nis(mm(l)) = surf_usm_v(l)%nis(m) 3535 IF ( ALLOCATED( surf_usm_v(l)%qrs ) ) & 3536 surf_v(l)%qrs(mm(l)) = surf_usm_v(l)%qrs(m) 3537 IF ( ALLOCATED( surf_usm_v(l)%nrs ) ) & 3538 surf_v(l)%nrs(mm(l)) = surf_usm_v(l)%nrs(m) 3539 IF ( ALLOCATED( surf_usm_v(l)%ol ) ) & 3540 surf_v(l)%ol(mm(l)) = surf_usm_v(l)%ol(m) 3541 IF ( ALLOCATED( surf_usm_v(l)%rib ) ) & 3542 surf_v(l)%rib(mm(l)) = surf_usm_v(l)%rib(m) 3543 IF ( ALLOCATED( surf_usm_v(l)%pt_surface ) ) & 3544 surf_v(l)%pt_surface(mm(l)) = surf_usm_v(l)%pt_surface(m) 3545 IF ( ALLOCATED( surf_usm_v(l)%q_surface ) ) & 3546 surf_v(l)%q_surface(mm(l)) = surf_usm_v(l)%q_surface(m) 3547 IF ( ALLOCATED( surf_usm_v(l)%vpt_surface ) ) & 3548 surf_v(l)%vpt_surface(mm(l)) = surf_usm_v(l)%vpt_surface(m) 3549 IF ( ALLOCATED( surf_usm_v(l)%usws ) ) & 3550 surf_v(l)%usws(mm(l)) = surf_usm_v(l)%usws(m) 3551 IF ( ALLOCATED( surf_usm_v(l)%vsws ) ) & 3552 surf_v(l)%vsws(mm(l)) = surf_usm_v(l)%vsws(m) 3553 IF ( ALLOCATED( surf_usm_v(l)%shf ) ) & 3554 surf_v(l)%shf(mm(l)) = surf_usm_v(l)%shf(m) 3555 IF ( ALLOCATED( surf_usm_v(l)%qsws ) ) & 3556 surf_v(l)%qsws(mm(l)) = surf_usm_v(l)%qsws(m) 3557 IF ( ALLOCATED( surf_usm_v(l)%ssws ) ) & 3558 surf_v(l)%ssws(mm(l)) = surf_usm_v(l)%ssws(m) 3559 IF ( ALLOCATED( surf_usm_v(l)%css ) ) THEN 3560 DO lsp = 1, nvar 3561 surf_v(l)%css(lsp,mm(l)) = surf_usm_v(l)%css(lsp,m) 3562 ENDDO 3563 ENDIF 3564 IF ( ALLOCATED( surf_usm_v(l)%cssws ) ) THEN 3565 DO lsp = 1, nvar 3566 surf_v(l)%cssws(lsp,mm(l)) = surf_usm_v(l)%cssws(lsp,m) 3567 ENDDO 3568 ENDIF 3569 IF ( ALLOCATED( surf_usm_v(l)%qcsws ) ) & 3570 surf_v(l)%qcsws(mm(l)) = surf_usm_v(l)%qcsws(m) 3571 IF ( ALLOCATED( surf_usm_v(l)%qrsws ) ) & 3572 surf_v(l)%qrsws(mm(l)) = surf_usm_v(l)%qrsws(m) 3573 IF ( ALLOCATED( surf_usm_v(l)%qisws ) ) & 3574 surf_v(l)%qisws(mm(l)) = surf_usm_v(l)%qisws(m) 3575 IF ( ALLOCATED( surf_usm_v(l)%ncsws ) ) & 3576 surf_v(l)%ncsws(mm(l)) = surf_usm_v(l)%ncsws(m) 3577 IF ( ALLOCATED( surf_usm_v(l)%nisws ) ) & 3578 surf_v(l)%nisws(mm(l)) = surf_usm_v(l)%nisws(m) 3579 IF ( ALLOCATED( surf_usm_v(l)%nrsws ) ) & 3580 surf_v(l)%nrsws(mm(l)) = surf_usm_v(l)%nrsws(m) 3581 IF ( ALLOCATED( surf_usm_v(l)%sasws ) ) & 3582 surf_v(l)%sasws(mm(l)) = surf_usm_v(l)%sasws(m) 3583 IF ( ALLOCATED( surf_usm_v(l)%mom_flux_uv) ) & 3584 surf_v(l)%mom_flux_uv(mm(l)) = surf_usm_v(l)%mom_flux_uv(m) 3585 IF ( ALLOCATED( surf_usm_v(l)%mom_flux_w) ) & 3586 surf_v(l)%mom_flux_w(mm(l)) = surf_usm_v(l)%mom_flux_w(m) 3587 IF ( ALLOCATED( surf_usm_v(l)%mom_flux_tke) ) & 3588 surf_v(l)%mom_flux_tke(0:1,mm(l)) = surf_usm_v(l)%mom_flux_tke(0:1,m) 3589 3590 mm(l) = mm(l) + 1 3591 ENDDO 3592 3593 ENDDO 3594 ENDDO 3595 ! 3596 !-- Recalculate start- and end-indices for gathered surface type 3597 start_index_v(l) = 1 3598 DO i = nxl, nxr 3599 DO j = nys, nyn 3600 3601 surf_v(l)%start_index(j,i) = start_index_v(l) 3602 surf_v(l)%end_index(j,i) = surf_v(l)%start_index(j,i) -1 3603 3604 DO m = surf_def_v(l)%start_index(j,i), & 3605 surf_def_v(l)%end_index(j,i) 3606 surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1 3607 ENDDO 3608 DO m = surf_lsm_v(l)%start_index(j,i), & 3609 surf_lsm_v(l)%end_index(j,i) 3610 surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1 3611 ENDDO 3612 DO m = surf_usm_v(l)%start_index(j,i), & 3613 surf_usm_v(l)%end_index(j,i) 3614 surf_v(l)%end_index(j,i) = surf_v(l)%end_index(j,i) + 1 3615 ENDDO 3616 3617 start_index_v(l) = surf_v(l)%end_index(j,i) + 1 3618 ENDDO 3619 ENDDO 3657 WRITE( dum, '(I1)') l 3658 3659 CALL wrd_write_string( 'surf_v(' // dum // ')%start_index' ) 3660 WRITE ( 14 ) surf_v(l)%start_index 3661 3662 CALL wrd_write_string( 'surf_v(' // dum // ')%end_index' ) 3663 WRITE ( 14 ) surf_v(l)%end_index 3664 3665 IF ( ALLOCATED ( surf_v(l)%us ) ) THEN 3666 CALL wrd_write_string( 'surf_v(' // dum // ')%us' ) 3667 WRITE ( 14 ) surf_v(l)%us 3668 ENDIF 3669 3670 IF ( ALLOCATED ( surf_v(l)%ts ) ) THEN 3671 CALL wrd_write_string( 'surf_v(' // dum // ')%ts' ) 3672 WRITE ( 14 ) surf_v(l)%ts 3673 ENDIF 3674 3675 IF ( ALLOCATED ( surf_v(l)%qs ) ) THEN 3676 CALL wrd_write_string( 'surf_v(' // dum // ')%qs' ) 3677 WRITE ( 14 ) surf_v(l)%qs 3678 ENDIF 3679 3680 IF ( ALLOCATED ( surf_v(l)%ss ) ) THEN 3681 CALL wrd_write_string( 'surf_v(' // dum // ')%ss' ) 3682 WRITE ( 14 ) surf_v(l)%ss 3683 ENDIF 3684 3685 IF ( ALLOCATED ( surf_v(l)%qcs ) ) THEN 3686 CALL wrd_write_string( 'surf_v(' // dum // ')%qcs' ) 3687 WRITE ( 14 ) surf_v(l)%qcs 3688 ENDIF 3689 3690 IF ( ALLOCATED ( surf_v(l)%ncs ) ) THEN 3691 CALL wrd_write_string( 'surf_v(' // dum // ')%ncs' ) 3692 WRITE ( 14 ) surf_v(l)%ncs 3693 ENDIF 3694 3695 IF ( ALLOCATED ( surf_v(l)%qis ) ) THEN 3696 CALL wrd_write_string( 'surf_v(' // dum // ')%qis' ) 3697 WRITE ( 14 ) surf_v(l)%qis 3698 ENDIF 3699 3700 IF ( ALLOCATED ( surf_v(l)%nis ) ) THEN 3701 CALL wrd_write_string( 'surf_v(' // dum // ')%nis' ) 3702 WRITE ( 14 ) surf_v(l)%nis 3703 ENDIF 3704 3705 IF ( ALLOCATED ( surf_v(l)%qrs ) ) THEN 3706 CALL wrd_write_string( 'surf_v(' // dum // ')%qrs' ) 3707 WRITE ( 14 ) surf_v(l)%qrs 3708 ENDIF 3709 3710 IF ( ALLOCATED ( surf_v(l)%nrs ) ) THEN 3711 CALL wrd_write_string( 'surf_v(' // dum // ')%nrs' ) 3712 WRITE ( 14 ) surf_v(l)%nrs 3713 ENDIF 3714 3715 IF ( ALLOCATED ( surf_v(l)%ol ) ) THEN 3716 CALL wrd_write_string( 'surf_v(' // dum // ')%ol' ) 3717 WRITE ( 14 ) surf_v(l)%ol 3718 ENDIF 3719 3720 IF ( ALLOCATED ( surf_v(l)%rib ) ) THEN 3721 CALL wrd_write_string( 'surf_v(' // dum // ')%rib' ) 3722 WRITE ( 14 ) surf_v(l)%rib 3723 ENDIF 3724 3725 IF ( ALLOCATED ( surf_v(l)%pt_surface ) ) THEN 3726 CALL wrd_write_string( 'surf_v(' // dum // ')%pt_surface' ) 3727 WRITE ( 14 ) surf_v(l)%pt_surface 3728 ENDIF 3729 3730 IF ( ALLOCATED ( surf_v(l)%q_surface ) ) THEN 3731 CALL wrd_write_string( 'surf_v(' // dum // ')%q_surface' ) 3732 WRITE ( 14 ) surf_v(l)%q_surface 3733 ENDIF 3734 3735 IF ( ALLOCATED ( surf_v(l)%vpt_surface ) ) THEN 3736 CALL wrd_write_string( 'surf_v(' // dum // ')%vpt_surface' ) 3737 WRITE ( 14 ) surf_v(l)%vpt_surface 3738 ENDIF 3739 3740 IF ( ALLOCATED ( surf_v(l)%shf ) ) THEN 3741 CALL wrd_write_string( 'surf_v(' // dum // ')%shf' ) 3742 WRITE ( 14 ) surf_v(l)%shf 3743 ENDIF 3744 3745 IF ( ALLOCATED ( surf_v(l)%qsws ) ) THEN 3746 CALL wrd_write_string( 'surf_v(' // dum // ')%qsws' ) 3747 WRITE ( 14 ) surf_v(l)%qsws 3748 ENDIF 3749 3750 IF ( ALLOCATED ( surf_v(l)%ssws ) ) THEN 3751 CALL wrd_write_string( 'surf_v(' // dum // ')%ssws' ) 3752 WRITE ( 14 ) surf_v(l)%ssws 3753 ENDIF 3754 3755 IF ( ALLOCATED ( surf_v(l)%css ) ) THEN 3756 CALL wrd_write_string( 'surf_v(' // dum // ')%css' ) 3757 WRITE ( 14 ) surf_v(l)%css 3758 ENDIF 3759 3760 IF ( ALLOCATED ( surf_v(l)%cssws ) ) THEN 3761 CALL wrd_write_string( 'surf_v(' // dum // ')%cssws' ) 3762 WRITE ( 14 ) surf_v(l)%cssws 3763 ENDIF 3764 3765 IF ( ALLOCATED ( surf_v(l)%qcsws ) ) THEN 3766 CALL wrd_write_string( 'surf_v(' // dum // ')%qcsws' ) 3767 WRITE ( 14 ) surf_v(l)%qcsws 3768 ENDIF 3769 3770 IF ( ALLOCATED ( surf_v(l)%ncsws ) ) THEN 3771 CALL wrd_write_string( 'surf_v(' // dum // ')%ncsws' ) 3772 WRITE ( 14 ) surf_v(l)%ncsws 3773 ENDIF 3774 3775 IF ( ALLOCATED ( surf_v(l)%qisws ) ) THEN 3776 CALL wrd_write_string( 'surf_v(' // dum // ')%qisws' ) 3777 WRITE ( 14 ) surf_v(l)%qisws 3778 ENDIF 3779 3780 IF ( ALLOCATED ( surf_v(l)%nisws ) ) THEN 3781 CALL wrd_write_string( 'surf_v(' // dum // ')%nisws' ) 3782 WRITE ( 14 ) surf_v(l)%nisws 3783 ENDIF 3784 3785 IF ( ALLOCATED ( surf_v(l)%qrsws ) ) THEN 3786 CALL wrd_write_string( 'surf_v(' // dum // ')%qrsws' ) 3787 WRITE ( 14 ) surf_v(l)%qrsws 3788 ENDIF 3789 3790 IF ( ALLOCATED ( surf_v(l)%nrsws ) ) THEN 3791 CALL wrd_write_string( 'surf_v(' // dum // ')%nrsws' ) 3792 WRITE ( 14 ) surf_v(l)%nrsws 3793 ENDIF 3794 3795 IF ( ALLOCATED ( surf_v(l)%sasws ) ) THEN 3796 CALL wrd_write_string( 'surf_v(' // dum // ')%sasws' ) 3797 WRITE ( 14 ) surf_v(l)%sasws 3798 ENDIF 3799 3800 IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) ) THEN 3801 CALL wrd_write_string( 'surf_v(' // dum // ')%mom_uv' ) 3802 WRITE ( 14 ) surf_v(l)%mom_flux_uv 3803 ENDIF 3804 3805 IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) ) THEN 3806 CALL wrd_write_string( 'surf_v(' // dum // ')%mom_w' ) 3807 WRITE ( 14 ) surf_v(l)%mom_flux_w 3808 ENDIF 3809 3810 IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) ) THEN 3811 CALL wrd_write_string( 'surf_v(' // dum // ')%mom_tke' ) 3812 WRITE ( 14 ) surf_v(l)%mom_flux_tke 3813 ENDIF 3620 3814 3621 3815 ENDDO 3622 3816 3623 ! 3624 !-- Now start writing restart data to file 3625 IF ( TRIM( restart_data_format_output ) == 'fortran_binary' ) THEN 3626 3627 ! 3628 !-- Output strings for the total number of upward / downward-facing surfaces 3629 !-- on subdomain. 3630 CALL wrd_write_string( 'ns_h_on_file' ) 3631 WRITE ( 14 ) ns_h_on_file 3632 ! 3633 !-- Output strings for the total number of north/south/east/westward-facing surfaces 3634 !-- on subdomain. 3635 CALL wrd_write_string( 'ns_v_on_file' ) 3636 WRITE ( 14 ) ns_v_on_file 3637 3638 ! 3639 !-- Horizontal surfaces (upward-, downward-facing, and model top). 3640 !-- Always start with %start_index followed by %end_index 3641 DO l = 0, 2 3642 WRITE( dum, '(I1)') l 3643 3644 CALL wrd_write_string( 'surf_h(' // dum // ')%start_index' ) 3645 WRITE ( 14 ) surf_h(l)%start_index 3646 3647 CALL wrd_write_string( 'surf_h(' // dum // ')%end_index' ) 3648 WRITE ( 14 ) surf_h(l)%end_index 3649 3650 IF ( ALLOCATED ( surf_h(l)%us ) ) THEN 3651 CALL wrd_write_string( 'surf_h(' // dum // ')%us' ) 3652 WRITE ( 14 ) surf_h(l)%us 3653 ENDIF 3654 3655 IF ( ALLOCATED ( surf_h(l)%ts ) ) THEN 3656 CALL wrd_write_string( 'surf_h(' // dum // ')%ts' ) 3657 WRITE ( 14 ) surf_h(l)%ts 3658 ENDIF 3659 3660 IF ( ALLOCATED ( surf_h(l)%qs ) ) THEN 3661 CALL wrd_write_string( 'surf_h(' // dum // ')%qs' ) 3662 WRITE ( 14 ) surf_h(l)%qs 3663 ENDIF 3664 3665 IF ( ALLOCATED ( surf_h(l)%ss ) ) THEN 3666 CALL wrd_write_string( 'surf_h(' // dum // ')%ss' ) 3667 WRITE ( 14 ) surf_h(l)%ss 3668 ENDIF 3669 3670 IF ( ALLOCATED ( surf_h(l)%qcs ) ) THEN 3671 CALL wrd_write_string( 'surf_h(' // dum // ')%qcs' ) 3672 WRITE ( 14 ) surf_h(l)%qcs 3673 ENDIF 3674 3675 IF ( ALLOCATED ( surf_h(l)%ncs ) ) THEN 3676 CALL wrd_write_string( 'surf_h(' // dum // ')%ncs' ) 3677 WRITE ( 14 ) surf_h(l)%ncs 3678 ENDIF 3679 3680 IF ( ALLOCATED ( surf_h(l)%qis ) ) THEN 3681 CALL wrd_write_string( 'surf_h(' // dum // ')%qis' ) 3682 WRITE ( 14 ) surf_h(l)%qis 3683 ENDIF 3684 3685 IF ( ALLOCATED ( surf_h(l)%nis ) ) THEN 3686 CALL wrd_write_string( 'surf_h(' // dum // ')%nis' ) 3687 WRITE ( 14 ) surf_h(l)%nis 3688 ENDIF 3689 3690 IF ( ALLOCATED ( surf_h(l)%qrs ) ) THEN 3691 CALL wrd_write_string( 'surf_h(' // dum // ')%qrs' ) 3692 WRITE ( 14 ) surf_h(l)%qrs 3693 ENDIF 3694 3695 IF ( ALLOCATED ( surf_h(l)%nrs ) ) THEN 3696 CALL wrd_write_string( 'surf_h(' // dum // ')%nrs' ) 3697 WRITE ( 14 ) surf_h(l)%nrs 3698 ENDIF 3699 3700 IF ( ALLOCATED ( surf_h(l)%ol ) ) THEN 3701 CALL wrd_write_string( 'surf_h(' // dum // ')%ol' ) 3702 WRITE ( 14 ) surf_h(l)%ol 3703 ENDIF 3704 3705 IF ( ALLOCATED ( surf_h(l)%rib ) ) THEN 3706 CALL wrd_write_string( 'surf_h(' // dum // ')%rib' ) 3707 WRITE ( 14 ) surf_h(l)%rib 3708 ENDIF 3709 3710 IF ( ALLOCATED ( surf_h(l)%pt_surface ) ) THEN 3711 CALL wrd_write_string( 'surf_h(' // dum // ')%pt_surface' ) 3712 WRITE ( 14 ) surf_h(l)%pt_surface 3713 ENDIF 3714 3715 IF ( ALLOCATED ( surf_h(l)%q_surface ) ) THEN 3716 CALL wrd_write_string( 'surf_h(' // dum // ')%q_surface' ) 3717 WRITE ( 14 ) surf_h(l)%q_surface 3718 ENDIF 3719 3720 IF ( ALLOCATED ( surf_h(l)%vpt_surface ) ) THEN 3721 CALL wrd_write_string( 'surf_h(' // dum // ')%vpt_surface' ) 3722 WRITE ( 14 ) surf_h(l)%vpt_surface 3723 ENDIF 3724 3725 IF ( ALLOCATED ( surf_h(l)%usws ) ) THEN 3726 CALL wrd_write_string( 'surf_h(' // dum // ')%usws' ) 3727 WRITE ( 14 ) surf_h(l)%usws 3728 ENDIF 3729 3730 IF ( ALLOCATED ( surf_h(l)%vsws ) ) THEN 3731 CALL wrd_write_string( 'surf_h(' // dum // ')%vsws' ) 3732 WRITE ( 14 ) surf_h(l)%vsws 3733 ENDIF 3734 3735 IF ( ALLOCATED ( surf_h(l)%shf ) ) THEN 3736 CALL wrd_write_string( 'surf_h(' // dum // ')%shf' ) 3737 WRITE ( 14 ) surf_h(l)%shf 3738 ENDIF 3739 3740 IF ( ALLOCATED ( surf_h(l)%qsws ) ) THEN 3741 CALL wrd_write_string( 'surf_h(' // dum // ')%qsws' ) 3742 WRITE ( 14 ) surf_h(l)%qsws 3743 ENDIF 3744 3745 IF ( ALLOCATED ( surf_h(l)%ssws ) ) THEN 3746 CALL wrd_write_string( 'surf_h(' // dum // ')%ssws' ) 3747 WRITE ( 14 ) surf_h(l)%ssws 3748 ENDIF 3749 3750 IF ( ALLOCATED ( surf_h(l)%css ) ) THEN 3751 CALL wrd_write_string( 'surf_h(' // dum // ')%css' ) 3752 WRITE ( 14 ) surf_h(l)%css 3753 ENDIF 3754 3755 IF ( ALLOCATED ( surf_h(l)%cssws ) ) THEN 3756 CALL wrd_write_string( 'surf_h(' // dum // ')%cssws' ) 3757 WRITE ( 14 ) surf_h(l)%cssws 3758 ENDIF 3759 3760 IF ( ALLOCATED ( surf_h(l)%qcsws ) ) THEN 3761 CALL wrd_write_string( 'surf_h(' // dum // ')%qcsws' ) 3762 WRITE ( 14 ) surf_h(l)%qcsws 3763 ENDIF 3764 3765 IF ( ALLOCATED ( surf_h(l)%ncsws ) ) THEN 3766 CALL wrd_write_string( 'surf_h(' // dum // ')%ncsws' ) 3767 WRITE ( 14 ) surf_h(l)%ncsws 3768 ENDIF 3769 3770 IF ( ALLOCATED ( surf_h(l)%qisws ) ) THEN 3771 CALL wrd_write_string( 'surf_h(' // dum // ')%qisws' ) 3772 WRITE ( 14 ) surf_h(l)%qisws 3773 ENDIF 3774 3775 IF ( ALLOCATED ( surf_h(l)%nisws ) ) THEN 3776 CALL wrd_write_string( 'surf_h(' // dum // ')%nisws' ) 3777 WRITE ( 14 ) surf_h(l)%nisws 3778 ENDIF 3779 3780 IF ( ALLOCATED ( surf_h(l)%qrsws ) ) THEN 3781 CALL wrd_write_string( 'surf_h(' // dum // ')%qrsws' ) 3782 WRITE ( 14 ) surf_h(l)%qrsws 3783 ENDIF 3784 3785 IF ( ALLOCATED ( surf_h(l)%nrsws ) ) THEN 3786 CALL wrd_write_string( 'surf_h(' // dum // ')%nrsws' ) 3787 WRITE ( 14 ) surf_h(l)%nrsws 3788 ENDIF 3789 3790 IF ( ALLOCATED ( surf_h(l)%sasws ) ) THEN 3791 CALL wrd_write_string( 'surf_h(' // dum // ')%sasws' ) 3792 WRITE ( 14 ) surf_h(l)%sasws 3793 ENDIF 3794 3795 ENDDO 3796 ! 3797 !-- Write vertical surfaces. 3798 !-- Always start with %start_index followed by %end_index. 3799 DO l = 0, 3 3800 WRITE( dum, '(I1)') l 3801 3802 CALL wrd_write_string( 'surf_v(' // dum // ')%start_index' ) 3803 WRITE ( 14 ) surf_v(l)%start_index 3804 3805 CALL wrd_write_string( 'surf_v(' // dum // ')%end_index' ) 3806 WRITE ( 14 ) surf_v(l)%end_index 3807 3808 IF ( ALLOCATED ( surf_v(l)%us ) ) THEN 3809 CALL wrd_write_string( 'surf_v(' // dum // ')%us' ) 3810 WRITE ( 14 ) surf_v(l)%us 3811 ENDIF 3812 3813 IF ( ALLOCATED ( surf_v(l)%ts ) ) THEN 3814 CALL wrd_write_string( 'surf_v(' // dum // ')%ts' ) 3815 WRITE ( 14 ) surf_v(l)%ts 3816 ENDIF 3817 3818 IF ( ALLOCATED ( surf_v(l)%qs ) ) THEN 3819 CALL wrd_write_string( 'surf_v(' // dum // ')%qs' ) 3820 WRITE ( 14 ) surf_v(l)%qs 3821 ENDIF 3822 3823 IF ( ALLOCATED ( surf_v(l)%ss ) ) THEN 3824 CALL wrd_write_string( 'surf_v(' // dum // ')%ss' ) 3825 WRITE ( 14 ) surf_v(l)%ss 3826 ENDIF 3827 3828 IF ( ALLOCATED ( surf_v(l)%qcs ) ) THEN 3829 CALL wrd_write_string( 'surf_v(' // dum // ')%qcs' ) 3830 WRITE ( 14 ) surf_v(l)%qcs 3831 ENDIF 3832 3833 IF ( ALLOCATED ( surf_v(l)%ncs ) ) THEN 3834 CALL wrd_write_string( 'surf_v(' // dum // ')%ncs' ) 3835 WRITE ( 14 ) surf_v(l)%ncs 3836 ENDIF 3837 3838 IF ( ALLOCATED ( surf_v(l)%qis ) ) THEN 3839 CALL wrd_write_string( 'surf_v(' // dum // ')%qis' ) 3840 WRITE ( 14 ) surf_v(l)%qis 3841 ENDIF 3842 3843 IF ( ALLOCATED ( surf_v(l)%nis ) ) THEN 3844 CALL wrd_write_string( 'surf_v(' // dum // ')%nis' ) 3845 WRITE ( 14 ) surf_v(l)%nis 3846 ENDIF 3847 3848 IF ( ALLOCATED ( surf_v(l)%qrs ) ) THEN 3849 CALL wrd_write_string( 'surf_v(' // dum // ')%qrs' ) 3850 WRITE ( 14 ) surf_v(l)%qrs 3851 ENDIF 3852 3853 IF ( ALLOCATED ( surf_v(l)%nrs ) ) THEN 3854 CALL wrd_write_string( 'surf_v(' // dum // ')%nrs' ) 3855 WRITE ( 14 ) surf_v(l)%nrs 3856 ENDIF 3857 3858 IF ( ALLOCATED ( surf_v(l)%ol ) ) THEN 3859 CALL wrd_write_string( 'surf_v(' // dum // ')%ol' ) 3860 WRITE ( 14 ) surf_v(l)%ol 3861 ENDIF 3862 3863 IF ( ALLOCATED ( surf_v(l)%rib ) ) THEN 3864 CALL wrd_write_string( 'surf_v(' // dum // ')%rib' ) 3865 WRITE ( 14 ) surf_v(l)%rib 3866 ENDIF 3867 3868 IF ( ALLOCATED ( surf_v(l)%pt_surface ) ) THEN 3869 CALL wrd_write_string( 'surf_v(' // dum // ')%pt_surface' ) 3870 WRITE ( 14 ) surf_v(l)%pt_surface 3871 ENDIF 3872 3873 IF ( ALLOCATED ( surf_v(l)%q_surface ) ) THEN 3874 CALL wrd_write_string( 'surf_v(' // dum // ')%q_surface' ) 3875 WRITE ( 14 ) surf_v(l)%q_surface 3876 ENDIF 3877 3878 IF ( ALLOCATED ( surf_v(l)%vpt_surface ) ) THEN 3879 CALL wrd_write_string( 'surf_v(' // dum // ')%vpt_surface' ) 3880 WRITE ( 14 ) surf_v(l)%vpt_surface 3881 ENDIF 3882 3883 IF ( ALLOCATED ( surf_v(l)%shf ) ) THEN 3884 CALL wrd_write_string( 'surf_v(' // dum // ')%shf' ) 3885 WRITE ( 14 ) surf_v(l)%shf 3886 ENDIF 3887 3888 IF ( ALLOCATED ( surf_v(l)%qsws ) ) THEN 3889 CALL wrd_write_string( 'surf_v(' // dum // ')%qsws' ) 3890 WRITE ( 14 ) surf_v(l)%qsws 3891 ENDIF 3892 3893 IF ( ALLOCATED ( surf_v(l)%ssws ) ) THEN 3894 CALL wrd_write_string( 'surf_v(' // dum // ')%ssws' ) 3895 WRITE ( 14 ) surf_v(l)%ssws 3896 ENDIF 3897 3898 IF ( ALLOCATED ( surf_v(l)%css ) ) THEN 3899 CALL wrd_write_string( 'surf_v(' // dum // ')%css' ) 3900 WRITE ( 14 ) surf_v(l)%css 3901 ENDIF 3902 3903 IF ( ALLOCATED ( surf_v(l)%cssws ) ) THEN 3904 CALL wrd_write_string( 'surf_v(' // dum // ')%cssws' ) 3905 WRITE ( 14 ) surf_v(l)%cssws 3906 ENDIF 3907 3908 IF ( ALLOCATED ( surf_v(l)%qcsws ) ) THEN 3909 CALL wrd_write_string( 'surf_v(' // dum // ')%qcsws' ) 3910 WRITE ( 14 ) surf_v(l)%qcsws 3911 ENDIF 3912 3913 IF ( ALLOCATED ( surf_v(l)%ncsws ) ) THEN 3914 CALL wrd_write_string( 'surf_v(' // dum // ')%ncsws' ) 3915 WRITE ( 14 ) surf_v(l)%ncsws 3916 ENDIF 3917 3918 IF ( ALLOCATED ( surf_v(l)%qisws ) ) THEN 3919 CALL wrd_write_string( 'surf_v(' // dum // ')%qisws' ) 3920 WRITE ( 14 ) surf_v(l)%qisws 3921 ENDIF 3922 3923 IF ( ALLOCATED ( surf_v(l)%nisws ) ) THEN 3924 CALL wrd_write_string( 'surf_v(' // dum // ')%nisws' ) 3925 WRITE ( 14 ) surf_v(l)%nisws 3926 ENDIF 3927 3928 IF ( ALLOCATED ( surf_v(l)%qrsws ) ) THEN 3929 CALL wrd_write_string( 'surf_v(' // dum // ')%qrsws' ) 3930 WRITE ( 14 ) surf_v(l)%qrsws 3931 ENDIF 3932 3933 IF ( ALLOCATED ( surf_v(l)%nrsws ) ) THEN 3934 CALL wrd_write_string( 'surf_v(' // dum // ')%nrsws' ) 3935 WRITE ( 14 ) surf_v(l)%nrsws 3936 ENDIF 3937 3938 IF ( ALLOCATED ( surf_v(l)%sasws ) ) THEN 3939 CALL wrd_write_string( 'surf_v(' // dum // ')%sasws' ) 3940 WRITE ( 14 ) surf_v(l)%sasws 3941 ENDIF 3942 3943 IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) ) THEN 3944 CALL wrd_write_string( 'surf_v(' // dum // ')%mom_uv' ) 3945 WRITE ( 14 ) surf_v(l)%mom_flux_uv 3946 ENDIF 3947 3948 IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) ) THEN 3949 CALL wrd_write_string( 'surf_v(' // dum // ')%mom_w' ) 3950 WRITE ( 14 ) surf_v(l)%mom_flux_w 3951 ENDIF 3952 3953 IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) ) THEN 3954 CALL wrd_write_string( 'surf_v(' // dum // ')%mom_tke' ) 3955 WRITE ( 14 ) surf_v(l)%mom_flux_tke 3956 ENDIF 3957 3958 ENDDO 3959 3960 ELSEIF ( restart_data_format_output(1:3) == 'mpi' ) THEN 3961 3962 ! 3963 !-- Start with horizontal surfaces (upward-, downward-facing, and model top). 3964 !-- All data writen with rd_mpi_io_write_surface are globally indexed 1d-arrays. 3965 ns_h_on_file = 0 3966 ns_v_on_file = 0 3967 3968 DO l = 0, 2 3969 3970 WRITE( dum, '(I1)') l 3971 3972 CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index, & 3973 surface_data_to_write, global_start_index ) 3974 IF ( .NOT. surface_data_to_write ) CYCLE 3975 3976 ns_h_on_file(l) = total_number_of_surface_values 3977 3978 CALL wrd_mpi_io( 'surf_h(' // dum // ')%start_index', surf_h(l)%start_index ) 3979 CALL wrd_mpi_io( 'surf_h(' // dum // ')%end_index', surf_h(l)%end_index ) 3980 CALL wrd_mpi_io( 'global_start_index_h_' // dum , global_start_index ) 3981 3982 IF ( ALLOCATED ( surf_h(l)%us ) ) THEN 3983 CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%us', surf_h(l)%us ) 3984 ENDIF 3985 3986 IF ( ALLOCATED ( surf_h(l)%ts ) ) THEN 3987 CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%ts', surf_h(l)%ts ) 3988 ENDIF 3989 3990 IF ( ALLOCATED ( surf_h(l)%qs ) ) THEN 3991 CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%qs', surf_h(l)%qs ) 3992 ENDIF 3993 3994 IF ( ALLOCATED ( surf_h(l)%ss ) ) THEN 3995 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ss', surf_h(l)%ss ) 3996 ENDIF 3997 3998 IF ( ALLOCATED ( surf_h(l)%qcs ) ) THEN 3999 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qcs', surf_h(l)%qcs ) 4000 ENDIF 4001 4002 IF ( ALLOCATED ( surf_h(l)%ncs ) ) THEN 4003 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ncs', surf_h(l)%ncs ) 4004 ENDIF 4005 4006 IF ( ALLOCATED ( surf_h(l)%qis ) ) THEN 4007 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qis', surf_h(l)%qis ) 4008 ENDIF 4009 4010 IF ( ALLOCATED ( surf_h(l)%nis ) ) THEN 4011 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nis', surf_h(l)%nis ) 4012 ENDIF 4013 4014 IF ( ALLOCATED ( surf_h(l)%qrs ) ) THEN 4015 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qrs', surf_h(l)%qrs ) 4016 ENDIF 4017 4018 IF ( ALLOCATED ( surf_h(l)%nrs ) ) THEN 4019 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nrs', surf_h(l)%nrs ) 4020 ENDIF 4021 4022 IF ( ALLOCATED ( surf_h(l)%ol ) ) THEN 4023 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ol', surf_h(l)%ol ) 4024 ENDIF 4025 4026 IF ( ALLOCATED ( surf_h(l)%rib ) ) THEN 4027 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%rib', surf_h(l)%rib ) 4028 ENDIF 4029 4030 IF ( ALLOCATED ( surf_h(l)%pt_surface ) ) THEN 4031 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%pt_surface', surf_h(l)%pt_surface ) 4032 ENDIF 4033 4034 IF ( ALLOCATED ( surf_h(l)%q_surface ) ) THEN 4035 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%q_surface', surf_h(l)%q_surface ) 4036 ENDIF 4037 4038 IF ( ALLOCATED ( surf_h(l)%vpt_surface ) ) THEN 4039 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%vpt_surface', surf_h(l)%vpt_surface ) 4040 ENDIF 4041 4042 IF ( ALLOCATED ( surf_h(l)%usws ) ) THEN 4043 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%usws', surf_h(l)%usws ) 4044 ENDIF 4045 4046 IF ( ALLOCATED ( surf_h(l)%vsws ) ) THEN 4047 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%vsws', surf_h(l)%vsws ) 4048 ENDIF 4049 4050 IF ( ALLOCATED ( surf_h(l)%shf ) ) THEN 4051 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%shf', surf_h(l)%shf ) 4052 ENDIF 4053 4054 IF ( ALLOCATED ( surf_h(l)%qsws ) ) THEN 4055 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qsws', surf_h(l)%qsws ) 4056 ENDIF 4057 4058 IF ( ALLOCATED ( surf_h(l)%ssws ) ) THEN 4059 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ssws', surf_h(l)%ssws ) 4060 ENDIF 4061 4062 IF ( ALLOCATED ( surf_h(l)%css ) ) THEN 4063 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%css', surf_h(l)%css ) 4064 ENDIF 4065 4066 IF ( ALLOCATED ( surf_h(l)%cssws ) ) THEN 4067 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%cssws', surf_h(l)%cssws ) 4068 ENDIF 4069 4070 IF ( ALLOCATED ( surf_h(l)%qcsws ) ) THEN 4071 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qcsws', surf_h(l)%qcsws ) 4072 ENDIF 4073 4074 IF ( ALLOCATED ( surf_h(l)%ncsws ) ) THEN 4075 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ncsws', surf_h(l)%ncsws ) 4076 ENDIF 4077 4078 IF ( ALLOCATED ( surf_h(l)%qisws ) ) THEN 4079 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qisws', surf_h(l)%qisws ) 4080 ENDIF 4081 4082 IF ( ALLOCATED ( surf_h(l)%nisws ) ) THEN 4083 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nisws', surf_h(l)%nisws ) 4084 ENDIF 4085 4086 IF ( ALLOCATED ( surf_h(l)%qrsws ) ) THEN 4087 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qrsws', surf_h(l)%qrsws ) 4088 ENDIF 4089 4090 IF ( ALLOCATED ( surf_h(l)%nrsws ) ) THEN 4091 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nrsws', surf_h(l)%nrsws ) 4092 ENDIF 4093 4094 IF ( ALLOCATED ( surf_h(l)%sasws ) ) THEN 4095 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%sasws', surf_h(l)%sasws ) 4096 ENDIF 4097 4098 ENDDO 4099 ! 4100 !-- Write vertical surfaces 4101 DO l = 0, 3 4102 4103 WRITE( dum, '(I1)') l 4104 4105 CALL rd_mpi_io_surface_filetypes( surf_v(l)%start_index, surf_v(l)%end_index, & 4106 surface_data_to_write, global_start_index ) 4107 4108 ns_v_on_file(l) = total_number_of_surface_values 4109 4110 CALL wrd_mpi_io( 'surf_v(' // dum // ')%start_index', surf_v(l)%start_index ) 4111 CALL wrd_mpi_io( 'surf_v(' // dum // ')%end_index', surf_v(l)%end_index ) 4112 CALL wrd_mpi_io( 'global_start_index_v_' // dum , global_start_index ) 4113 4114 IF ( .NOT. surface_data_to_write ) CYCLE 4115 4116 IF ( ALLOCATED ( surf_v(l)%us ) ) THEN 4117 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%us', surf_v(l)%us ) 4118 ENDIF 4119 4120 IF ( ALLOCATED ( surf_v(l)%ts ) ) THEN 4121 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ts', surf_v(l)%ts ) 4122 ENDIF 4123 4124 IF ( ALLOCATED ( surf_v(l)%qs ) ) THEN 4125 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qs', surf_v(l)%qs ) 4126 ENDIF 4127 4128 IF ( ALLOCATED ( surf_v(l)%ss ) ) THEN 4129 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ss', surf_v(l)%ss ) 4130 ENDIF 4131 4132 IF ( ALLOCATED ( surf_v(l)%qcs ) ) THEN 4133 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qcs', surf_v(l)%qcs ) 4134 ENDIF 4135 4136 IF ( ALLOCATED ( surf_v(l)%ncs ) ) THEN 4137 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ncs', surf_v(l)%ncs ) 4138 ENDIF 4139 4140 IF ( ALLOCATED ( surf_v(l)%qis ) ) THEN 4141 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qis', surf_v(l)%qis ) 4142 ENDIF 4143 4144 IF ( ALLOCATED ( surf_v(l)%nis ) ) THEN 4145 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nis', surf_v(l)%nis ) 4146 ENDIF 4147 4148 IF ( ALLOCATED ( surf_v(l)%qrs ) ) THEN 4149 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qrs', surf_v(l)%qrs ) 4150 ENDIF 4151 4152 IF ( ALLOCATED ( surf_v(l)%nrs ) ) THEN 4153 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nrs', surf_v(l)%nrs ) 4154 ENDIF 4155 4156 IF ( ALLOCATED ( surf_v(l)%ol ) ) THEN 4157 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ol', surf_v(l)%ol ) 4158 ENDIF 4159 4160 IF ( ALLOCATED ( surf_v(l)%rib ) ) THEN 4161 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%rib', surf_v(l)%rib ) 4162 ENDIF 4163 4164 IF ( ALLOCATED ( surf_v(l)%pt_surface ) ) THEN 4165 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%pt_surface', surf_v(l)%pt_surface ) 4166 ENDIF 4167 4168 IF ( ALLOCATED ( surf_v(l)%q_surface ) ) THEN 4169 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%q_surface', surf_v(l)%q_surface ) 4170 ENDIF 4171 4172 IF ( ALLOCATED ( surf_v(l)%vpt_surface ) ) THEN 4173 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%vpt_surface', surf_v(l)%vpt_surface ) 4174 ENDIF 4175 4176 IF ( ALLOCATED ( surf_v(l)%shf ) ) THEN 4177 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%shf', surf_v(l)%shf ) 4178 ENDIF 4179 4180 IF ( ALLOCATED ( surf_v(l)%qsws ) ) THEN 4181 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qsws', surf_v(l)%qsws ) 4182 ENDIF 4183 4184 IF ( ALLOCATED ( surf_v(l)%ssws ) ) THEN 4185 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ssws', surf_v(l)%ssws ) 4186 ENDIF 4187 4188 IF ( ALLOCATED ( surf_v(l)%css ) ) THEN 4189 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%css', surf_v(l)%css ) 4190 ENDIF 4191 4192 IF ( ALLOCATED ( surf_v(l)%cssws ) ) THEN 4193 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%cssws', surf_v(l)%cssws ) 4194 ENDIF 4195 4196 IF ( ALLOCATED ( surf_v(l)%qcsws ) ) THEN 4197 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qcsws', surf_v(l)%qcsws ) 4198 ENDIF 4199 4200 IF ( ALLOCATED ( surf_v(l)%ncsws ) ) THEN 4201 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ncsws', surf_v(l)%ncsws ) 4202 ENDIF 4203 4204 IF ( ALLOCATED ( surf_v(l)%qisws ) ) THEN 4205 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qisws', surf_v(l)%qisws ) 4206 ENDIF 4207 4208 IF ( ALLOCATED ( surf_v(l)%nisws ) ) THEN 4209 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nisws', surf_v(l)%nisws ) 4210 ENDIF 4211 4212 IF ( ALLOCATED ( surf_v(l)%qrsws ) ) THEN 4213 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qrsws', surf_v(l)%qrsws ) 4214 ENDIF 4215 4216 IF ( ALLOCATED ( surf_v(l)%nrsws ) ) THEN 4217 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nrsws', surf_v(l)%nrsws ) 4218 ENDIF 4219 4220 IF ( ALLOCATED ( surf_v(l)%sasws ) ) THEN 4221 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%sasws', surf_v(l)%sasws ) 4222 ENDIF 4223 4224 IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) ) THEN 4225 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_uv', surf_v(l)%mom_flux_uv ) 4226 ENDIF 4227 4228 IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) ) THEN 4229 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_w', surf_v(l)%mom_flux_w ) 4230 ENDIF 4231 4232 IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) ) THEN 4233 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_tke', surf_v(l)%mom_flux_tke ) 4234 ENDIF 4235 4236 ENDDO 4237 4238 CALL wrd_mpi_io_global_array( 'ns_h_on_file', ns_h_on_file ) 4239 CALL wrd_mpi_io_global_array( 'ns_v_on_file', ns_v_on_file ) 4240 4241 ENDIF 4242 4243 END SUBROUTINE surface_wrd_local 4244 4245 4246 !------------------------------------------------------------------------------! 3817 ELSEIF ( restart_data_format_output(1:3) == 'mpi' ) THEN 3818 3819 ! 3820 !-- Start with horizontal surfaces (upward-, downward-facing, and model top). 3821 !-- All data writen with rd_mpi_io_write_surface are globally indexed 1d-arrays. 3822 ns_h_on_file = 0 3823 ns_v_on_file = 0 3824 3825 DO l = 0, 2 3826 3827 WRITE( dum, '(I1)') l 3828 3829 CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index, & 3830 surface_data_to_write, global_start_index ) 3831 IF ( .NOT. surface_data_to_write ) CYCLE 3832 3833 ns_h_on_file(l) = total_number_of_surface_values 3834 3835 CALL wrd_mpi_io( 'surf_h(' // dum // ')%start_index', surf_h(l)%start_index ) 3836 CALL wrd_mpi_io( 'surf_h(' // dum // ')%end_index', surf_h(l)%end_index ) 3837 CALL wrd_mpi_io( 'global_start_index_h_' // dum, global_start_index ) 3838 3839 IF ( ALLOCATED ( surf_h(l)%us ) ) THEN 3840 CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%us', surf_h(l)%us ) 3841 ENDIF 3842 3843 IF ( ALLOCATED ( surf_h(l)%ts ) ) THEN 3844 CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%ts', surf_h(l)%ts ) 3845 ENDIF 3846 3847 IF ( ALLOCATED ( surf_h(l)%qs ) ) THEN 3848 CALL wrd_mpi_io_surface ( 'surf_h(' // dum // ')%qs', surf_h(l)%qs ) 3849 ENDIF 3850 3851 IF ( ALLOCATED ( surf_h(l)%ss ) ) THEN 3852 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ss', surf_h(l)%ss ) 3853 ENDIF 3854 3855 IF ( ALLOCATED ( surf_h(l)%qcs ) ) THEN 3856 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qcs', surf_h(l)%qcs ) 3857 ENDIF 3858 3859 IF ( ALLOCATED ( surf_h(l)%ncs ) ) THEN 3860 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ncs', surf_h(l)%ncs ) 3861 ENDIF 3862 3863 IF ( ALLOCATED ( surf_h(l)%qis ) ) THEN 3864 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qis', surf_h(l)%qis ) 3865 ENDIF 3866 3867 IF ( ALLOCATED ( surf_h(l)%nis ) ) THEN 3868 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nis', surf_h(l)%nis ) 3869 ENDIF 3870 3871 IF ( ALLOCATED ( surf_h(l)%qrs ) ) THEN 3872 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qrs', surf_h(l)%qrs ) 3873 ENDIF 3874 3875 IF ( ALLOCATED ( surf_h(l)%nrs ) ) THEN 3876 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nrs', surf_h(l)%nrs ) 3877 ENDIF 3878 3879 IF ( ALLOCATED ( surf_h(l)%ol ) ) THEN 3880 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ol', surf_h(l)%ol ) 3881 ENDIF 3882 3883 IF ( ALLOCATED ( surf_h(l)%rib ) ) THEN 3884 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%rib', surf_h(l)%rib ) 3885 ENDIF 3886 3887 IF ( ALLOCATED ( surf_h(l)%pt_surface ) ) THEN 3888 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%pt_surface', surf_h(l)%pt_surface ) 3889 ENDIF 3890 3891 IF ( ALLOCATED ( surf_h(l)%q_surface ) ) THEN 3892 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%q_surface', surf_h(l)%q_surface ) 3893 ENDIF 3894 3895 IF ( ALLOCATED ( surf_h(l)%vpt_surface ) ) THEN 3896 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%vpt_surface', surf_h(l)%vpt_surface ) 3897 ENDIF 3898 3899 IF ( ALLOCATED ( surf_h(l)%usws ) ) THEN 3900 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%usws', surf_h(l)%usws ) 3901 ENDIF 3902 3903 IF ( ALLOCATED ( surf_h(l)%vsws ) ) THEN 3904 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%vsws', surf_h(l)%vsws ) 3905 ENDIF 3906 3907 IF ( ALLOCATED ( surf_h(l)%shf ) ) THEN 3908 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%shf', surf_h(l)%shf ) 3909 ENDIF 3910 3911 IF ( ALLOCATED ( surf_h(l)%qsws ) ) THEN 3912 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qsws', surf_h(l)%qsws ) 3913 ENDIF 3914 3915 IF ( ALLOCATED ( surf_h(l)%ssws ) ) THEN 3916 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ssws', surf_h(l)%ssws ) 3917 ENDIF 3918 3919 IF ( ALLOCATED ( surf_h(l)%css ) ) THEN 3920 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%css', surf_h(l)%css ) 3921 ENDIF 3922 3923 IF ( ALLOCATED ( surf_h(l)%cssws ) ) THEN 3924 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%cssws', surf_h(l)%cssws ) 3925 ENDIF 3926 3927 IF ( ALLOCATED ( surf_h(l)%qcsws ) ) THEN 3928 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qcsws', surf_h(l)%qcsws ) 3929 ENDIF 3930 3931 IF ( ALLOCATED ( surf_h(l)%ncsws ) ) THEN 3932 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%ncsws', surf_h(l)%ncsws ) 3933 ENDIF 3934 3935 IF ( ALLOCATED ( surf_h(l)%qisws ) ) THEN 3936 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qisws', surf_h(l)%qisws ) 3937 ENDIF 3938 3939 IF ( ALLOCATED ( surf_h(l)%nisws ) ) THEN 3940 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nisws', surf_h(l)%nisws ) 3941 ENDIF 3942 3943 IF ( ALLOCATED ( surf_h(l)%qrsws ) ) THEN 3944 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%qrsws', surf_h(l)%qrsws ) 3945 ENDIF 3946 3947 IF ( ALLOCATED ( surf_h(l)%nrsws ) ) THEN 3948 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%nrsws', surf_h(l)%nrsws ) 3949 ENDIF 3950 3951 IF ( ALLOCATED ( surf_h(l)%sasws ) ) THEN 3952 CALL wrd_mpi_io_surface( 'surf_h(' // dum // ')%sasws', surf_h(l)%sasws ) 3953 ENDIF 3954 3955 ENDDO 3956 ! 3957 !-- Write vertical surfaces 3958 DO l = 0, 3 3959 3960 WRITE( dum, '(I1)') l 3961 3962 CALL rd_mpi_io_surface_filetypes( surf_v(l)%start_index, surf_v(l)%end_index, & 3963 surface_data_to_write, global_start_index ) 3964 3965 ns_v_on_file(l) = total_number_of_surface_values 3966 3967 CALL wrd_mpi_io( 'surf_v(' // dum // ')%start_index', surf_v(l)%start_index ) 3968 CALL wrd_mpi_io( 'surf_v(' // dum // ')%end_index', surf_v(l)%end_index ) 3969 CALL wrd_mpi_io( 'global_start_index_v_' // dum, global_start_index ) 3970 3971 IF ( .NOT. surface_data_to_write ) CYCLE 3972 3973 IF ( ALLOCATED ( surf_v(l)%us ) ) THEN 3974 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%us', surf_v(l)%us ) 3975 ENDIF 3976 3977 IF ( ALLOCATED ( surf_v(l)%ts ) ) THEN 3978 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ts', surf_v(l)%ts ) 3979 ENDIF 3980 3981 IF ( ALLOCATED ( surf_v(l)%qs ) ) THEN 3982 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qs', surf_v(l)%qs ) 3983 ENDIF 3984 3985 IF ( ALLOCATED ( surf_v(l)%ss ) ) THEN 3986 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ss', surf_v(l)%ss ) 3987 ENDIF 3988 3989 IF ( ALLOCATED ( surf_v(l)%qcs ) ) THEN 3990 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qcs', surf_v(l)%qcs ) 3991 ENDIF 3992 3993 IF ( ALLOCATED ( surf_v(l)%ncs ) ) THEN 3994 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ncs', surf_v(l)%ncs ) 3995 ENDIF 3996 3997 IF ( ALLOCATED ( surf_v(l)%qis ) ) THEN 3998 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qis', surf_v(l)%qis ) 3999 ENDIF 4000 4001 IF ( ALLOCATED ( surf_v(l)%nis ) ) THEN 4002 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nis', surf_v(l)%nis ) 4003 ENDIF 4004 4005 IF ( ALLOCATED ( surf_v(l)%qrs ) ) THEN 4006 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qrs', surf_v(l)%qrs ) 4007 ENDIF 4008 4009 IF ( ALLOCATED ( surf_v(l)%nrs ) ) THEN 4010 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nrs', surf_v(l)%nrs ) 4011 ENDIF 4012 4013 IF ( ALLOCATED ( surf_v(l)%ol ) ) THEN 4014 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ol', surf_v(l)%ol ) 4015 ENDIF 4016 4017 IF ( ALLOCATED ( surf_v(l)%rib ) ) THEN 4018 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%rib', surf_v(l)%rib ) 4019 ENDIF 4020 4021 IF ( ALLOCATED ( surf_v(l)%pt_surface ) ) THEN 4022 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%pt_surface', surf_v(l)%pt_surface ) 4023 ENDIF 4024 4025 IF ( ALLOCATED ( surf_v(l)%q_surface ) ) THEN 4026 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%q_surface', surf_v(l)%q_surface ) 4027 ENDIF 4028 4029 IF ( ALLOCATED ( surf_v(l)%vpt_surface ) ) THEN 4030 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%vpt_surface', surf_v(l)%vpt_surface ) 4031 ENDIF 4032 4033 IF ( ALLOCATED ( surf_v(l)%shf ) ) THEN 4034 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%shf', surf_v(l)%shf ) 4035 ENDIF 4036 4037 IF ( ALLOCATED ( surf_v(l)%qsws ) ) THEN 4038 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qsws', surf_v(l)%qsws ) 4039 ENDIF 4040 4041 IF ( ALLOCATED ( surf_v(l)%ssws ) ) THEN 4042 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ssws', surf_v(l)%ssws ) 4043 ENDIF 4044 4045 IF ( ALLOCATED ( surf_v(l)%css ) ) THEN 4046 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%css', surf_v(l)%css ) 4047 ENDIF 4048 4049 IF ( ALLOCATED ( surf_v(l)%cssws ) ) THEN 4050 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%cssws', surf_v(l)%cssws ) 4051 ENDIF 4052 4053 IF ( ALLOCATED ( surf_v(l)%qcsws ) ) THEN 4054 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qcsws', surf_v(l)%qcsws ) 4055 ENDIF 4056 4057 IF ( ALLOCATED ( surf_v(l)%ncsws ) ) THEN 4058 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%ncsws', surf_v(l)%ncsws ) 4059 ENDIF 4060 4061 IF ( ALLOCATED ( surf_v(l)%qisws ) ) THEN 4062 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qisws', surf_v(l)%qisws ) 4063 ENDIF 4064 4065 IF ( ALLOCATED ( surf_v(l)%nisws ) ) THEN 4066 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nisws', surf_v(l)%nisws ) 4067 ENDIF 4068 4069 IF ( ALLOCATED ( surf_v(l)%qrsws ) ) THEN 4070 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%qrsws', surf_v(l)%qrsws ) 4071 ENDIF 4072 4073 IF ( ALLOCATED ( surf_v(l)%nrsws ) ) THEN 4074 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%nrsws', surf_v(l)%nrsws ) 4075 ENDIF 4076 4077 IF ( ALLOCATED ( surf_v(l)%sasws ) ) THEN 4078 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%sasws', surf_v(l)%sasws ) 4079 ENDIF 4080 4081 IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) ) THEN 4082 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_uv', surf_v(l)%mom_flux_uv ) 4083 ENDIF 4084 4085 IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) ) THEN 4086 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_w', surf_v(l)%mom_flux_w ) 4087 ENDIF 4088 4089 IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) ) THEN 4090 CALL wrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_tke', surf_v(l)%mom_flux_tke ) 4091 ENDIF 4092 4093 ENDDO 4094 4095 CALL wrd_mpi_io_global_array( 'ns_h_on_file', ns_h_on_file ) 4096 CALL wrd_mpi_io_global_array( 'ns_v_on_file', ns_v_on_file ) 4097 4098 ENDIF 4099 4100 END SUBROUTINE surface_wrd_local 4101 4102 4103 !--------------------------------------------------------------------------------------------------! 4247 4104 ! Description: 4248 4105 ! ------------ 4249 !> Reads surface-related restart data in Fortran binary format. Please note, restart data for a certain 4250 !> surface orientation (e.g. horizontal upward-facing) is stored in one 4251 !> array, even if surface elements may belong to different surface types 4252 !> natural or urban for example). Surface elements are redistributed into its 4253 !> respective surface types within this routine. This allows e.g. changing the 4254 !> surface type after reading the restart data, which might be required in case 4106 !> Reads surface-related restart data in Fortran binary format. Please note, restart data for a 4107 !> certain surface orientation (e.g. horizontal upward-facing) is stored in one array, even if 4108 !> surface elements may belong to different surface types natural or urban for example). Surface 4109 !> elements are redistributed into its respective surface types within this routine. This allows 4110 !> e.g. changing the surface type after reading the restart data, which might be required in case 4255 4111 !> of cyclic_fill mode. 4256 !------------------------------------------------------------------------------! 4257 SUBROUTINE surface_rrd_local_ftn( kk, nxlf, nxlc, nxl_on_file, nxrf, & 4258 nxr_on_file, nynf, nyn_on_file, nysf, & 4259 nysc, nys_on_file, found ) 4260 4261 4262 IMPLICIT NONE 4263 4264 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 4265 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 4266 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 4267 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 4268 INTEGER(iwp) :: m !< running index for surface elements, refers to gathered array encompassing all surface types 4269 INTEGER(iwp) :: mm !< running index for surface elements, refers to individual surface types 4270 INTEGER(iwp) :: kk !< running index over previous input files covering current local domain 4271 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 4272 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 4273 INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain 4274 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 4275 INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain 4276 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 4277 INTEGER(iwp) :: nyn_on_file !< index of norht boundary on former local domain 4278 INTEGER(iwp) :: nysc !< index of south boundary on current subdomain 4279 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 4280 INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain 4281 4282 INTEGER(iwp), SAVE :: l !< index variable for surface type 4283 4284 LOGICAL :: surf_match_def !< flag indicating that surface element is of default type 4285 LOGICAL :: surf_match_lsm !< flag indicating that surface element is of natural type 4286 LOGICAL :: surf_match_usm !< flag indicating that surface element is of urban type 4287 4288 LOGICAL, INTENT(OUT) :: found 4289 4290 LOGICAL, SAVE :: horizontal_surface !< flag indicating horizontal surfaces 4291 LOGICAL, SAVE :: vertical_surface !< flag indicating vertical surfaces 4292 4293 TYPE(surf_type), DIMENSION(0:2), SAVE :: surf_h !< horizontal surface type on file 4294 TYPE(surf_type), DIMENSION(0:3), SAVE :: surf_v !< vertical surface type on file 4295 4296 4297 found = .TRUE. 4298 4299 SELECT CASE ( restart_string(1:length) ) 4300 ! 4301 !-- Read the number of horizontally orientated surface elements and 4302 !-- allocate arrays 4303 CASE ( 'ns_h_on_file' ) 4304 IF ( kk == 1 ) THEN 4305 READ ( 13 ) ns_h_on_file 4306 4307 IF ( ALLOCATED( surf_h(0)%start_index ) ) & 4308 CALL deallocate_surface_attributes_h( surf_h(0) ) 4309 IF ( ALLOCATED( surf_h(1)%start_index ) ) & 4310 CALL deallocate_surface_attributes_h( surf_h(1) ) 4311 IF ( ALLOCATED( surf_h(2)%start_index ) ) & 4312 CALL deallocate_surface_attributes_h_top( surf_h(2) ) 4313 ! 4314 !-- Allocate memory for number of surface elements on file. 4315 !-- Please note, these number is not necessarily the same as 4316 !-- the final number of surface elements on local domain, 4317 !-- which is the case if processor topology changes during 4318 !-- restart runs. 4319 !-- Horizontal upward facing 4320 surf_h(0)%ns = ns_h_on_file(0) 4321 CALL allocate_surface_attributes_h( surf_h(0), & 4322 nys_on_file, nyn_on_file, & 4323 nxl_on_file, nxr_on_file ) 4324 ! 4325 !-- Horizontal downward facing 4326 surf_h(1)%ns = ns_h_on_file(1) 4327 CALL allocate_surface_attributes_h( surf_h(1), & 4328 nys_on_file, nyn_on_file, & 4329 nxl_on_file, nxr_on_file ) 4330 ! 4331 !-- Model top 4332 surf_h(2)%ns = ns_h_on_file(2) 4333 CALL allocate_surface_attributes_h_top( surf_h(2), & 4334 nys_on_file, nyn_on_file, & 4335 nxl_on_file, nxr_on_file ) 4336 4337 ! 4338 !-- Initial setting of flags for horizontal and vertical surfaces, 4339 !-- will be set after start- and end-indices are read. 4340 horizontal_surface = .FALSE. 4341 vertical_surface = .FALSE. 4342 4112 !--------------------------------------------------------------------------------------------------! 4113 SUBROUTINE surface_rrd_local_ftn( kk, nxlf, nxlc, nxl_on_file, nxrf, nxr_on_file, nynf, & 4114 nyn_on_file, nysf, nysc, nys_on_file, found ) 4115 4116 4117 IMPLICIT NONE 4118 4119 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 4120 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 4121 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 4122 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 4123 INTEGER(iwp) :: m !< running index for surface elements, refers to gathered array encompassing all surface types 4124 INTEGER(iwp) :: mm !< running index for surface elements, refers to individual surface types 4125 INTEGER(iwp) :: kk !< running index over previous input files covering current local domain 4126 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 4127 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 4128 INTEGER(iwp) :: nxl_on_file !< index of left boundary on former local domain 4129 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 4130 INTEGER(iwp) :: nxr_on_file !< index of right boundary on former local domain 4131 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 4132 INTEGER(iwp) :: nyn_on_file !< index of norht boundary on former local domain 4133 INTEGER(iwp) :: nysc !< index of south boundary on current subdomain 4134 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 4135 INTEGER(iwp) :: nys_on_file !< index of south boundary on former local domain 4136 4137 INTEGER(iwp), SAVE :: l !< index variable for surface type 4138 4139 LOGICAL :: surf_match_def !< flag indicating that surface element is of default type 4140 LOGICAL :: surf_match_lsm !< flag indicating that surface element is of natural type 4141 LOGICAL :: surf_match_usm !< flag indicating that surface element is of urban type 4142 4143 LOGICAL, INTENT(OUT) :: found !< 4144 4145 LOGICAL, SAVE :: horizontal_surface !< flag indicating horizontal surfaces 4146 LOGICAL, SAVE :: vertical_surface !< flag indicating vertical surfaces 4147 4148 TYPE(surf_type), DIMENSION(0:2), SAVE :: surf_h !< horizontal surface type on file 4149 TYPE(surf_type), DIMENSION(0:3), SAVE :: surf_v !< vertical surface type on file 4150 4151 4152 found = .TRUE. 4153 4154 SELECT CASE ( restart_string(1:length) ) 4155 ! 4156 !-- Read the number of horizontally orientated surface elements and allocate arrays 4157 CASE ( 'ns_h_on_file' ) 4158 IF ( kk == 1 ) THEN 4159 READ ( 13 ) ns_h_on_file 4160 4161 IF ( ALLOCATED( surf_h(0)%start_index ) ) & 4162 CALL deallocate_surface_attributes_h( surf_h(0) ) 4163 IF ( ALLOCATED( surf_h(1)%start_index ) ) & 4164 CALL deallocate_surface_attributes_h( surf_h(1) ) 4165 IF ( ALLOCATED( surf_h(2)%start_index ) ) & 4166 CALL deallocate_surface_attributes_h_top( surf_h(2) ) 4167 ! 4168 !-- Allocate memory for number of surface elements on file. 4169 !-- Please note, this number is not necessarily the same as the final number of surface 4170 !-- elements on local domain, which is the case if processor topology changes during 4171 !-- restart runs. 4172 !-- Horizontal upward facing 4173 surf_h(0)%ns = ns_h_on_file(0) 4174 CALL allocate_surface_attributes_h( surf_h(0), nys_on_file, nyn_on_file, nxl_on_file, & 4175 nxr_on_file ) 4176 ! 4177 !-- Horizontal downward facing 4178 surf_h(1)%ns = ns_h_on_file(1) 4179 CALL allocate_surface_attributes_h( surf_h(1), nys_on_file, nyn_on_file, nxl_on_file, & 4180 nxr_on_file ) 4181 ! 4182 !-- Model top 4183 surf_h(2)%ns = ns_h_on_file(2) 4184 CALL allocate_surface_attributes_h_top( surf_h(2), nys_on_file, nyn_on_file, & 4185 nxl_on_file, nxr_on_file ) 4186 4187 ! 4188 !-- Initial setting of flags for horizontal and vertical surfaces, will be set after start- 4189 !-- and end-indices are read. 4190 horizontal_surface = .FALSE. 4191 vertical_surface = .FALSE. 4192 4193 ENDIF 4194 ! 4195 !-- Read the number of vertically orientated surface elements and allocate arrays 4196 CASE ( 'ns_v_on_file' ) 4197 IF ( kk == 1 ) THEN 4198 READ ( 13 ) ns_v_on_file 4199 4200 DO l = 0, 3 4201 IF ( ALLOCATED( surf_v(l)%start_index ) ) & 4202 CALL deallocate_surface_attributes_v( surf_v(l) ) 4203 ENDDO 4204 4205 DO l = 0, 3 4206 surf_v(l)%ns = ns_v_on_file(l) 4207 CALL allocate_surface_attributes_v( surf_v(l), nys_on_file, nyn_on_file, & 4208 nxl_on_file, nxr_on_file ) 4209 ENDDO 4210 4211 ENDIF 4212 ! 4213 !-- Read start and end indices of surface elements at each (ji)-gridpoint 4214 CASE ( 'surf_h(0)%start_index' ) 4215 IF ( kk == 1 ) & 4216 READ ( 13 ) surf_h(0)%start_index 4217 l = 0 4218 CASE ( 'surf_h(0)%end_index' ) 4219 IF ( kk == 1 ) & 4220 READ ( 13 ) surf_h(0)%end_index 4221 horizontal_surface = .TRUE. 4222 vertical_surface = .FALSE. 4223 ! 4224 !-- Read specific attributes 4225 CASE ( 'surf_h(0)%us' ) 4226 IF ( ALLOCATED( surf_h(0)%us ) .AND. kk == 1 ) & 4227 READ ( 13 ) surf_h(0)%us 4228 CASE ( 'surf_h(0)%ts' ) 4229 IF ( ALLOCATED( surf_h(0)%ts ) .AND. kk == 1 ) & 4230 READ ( 13 ) surf_h(0)%ts 4231 CASE ( 'surf_h(0)%qs' ) 4232 IF ( ALLOCATED( surf_h(0)%qs ) .AND. kk == 1 ) & 4233 READ ( 13 ) surf_h(0)%qs 4234 CASE ( 'surf_h(0)%ss' ) 4235 IF ( ALLOCATED( surf_h(0)%ss ) .AND. kk == 1 ) & 4236 READ ( 13 ) surf_h(0)%ss 4237 CASE ( 'surf_h(0)%qcs' ) 4238 IF ( ALLOCATED( surf_h(0)%qcs ) .AND. kk == 1 ) & 4239 READ ( 13 ) surf_h(0)%qcs 4240 CASE ( 'surf_h(0)%ncs' ) 4241 IF ( ALLOCATED( surf_h(0)%ncs ) .AND. kk == 1 ) & 4242 READ ( 13 ) surf_h(0)%ncs 4243 CASE ( 'surf_h(0)%qis' ) 4244 IF ( ALLOCATED( surf_h(0)%qis ) .AND. kk == 1 ) & 4245 READ ( 13 ) surf_h(0)%qis 4246 CASE ( 'surf_h(0)%nis' ) 4247 IF ( ALLOCATED( surf_h(0)%nis ) .AND. kk == 1 ) & 4248 READ ( 13 ) surf_h(0)%nis 4249 CASE ( 'surf_h(0)%qrs' ) 4250 IF ( ALLOCATED( surf_h(0)%qrs ) .AND. kk == 1 ) & 4251 READ ( 13 ) surf_h(0)%qrs 4252 CASE ( 'surf_h(0)%nrs' ) 4253 IF ( ALLOCATED( surf_h(0)%nrs ) .AND. kk == 1 ) & 4254 READ ( 13 ) surf_h(0)%nrs 4255 CASE ( 'surf_h(0)%ol' ) 4256 IF ( ALLOCATED( surf_h(0)%ol ) .AND. kk == 1 ) & 4257 READ ( 13 ) surf_h(0)%ol 4258 CASE ( 'surf_h(0)%rib' ) 4259 IF ( ALLOCATED( surf_h(0)%rib ) .AND. kk == 1 ) & 4260 READ ( 13 ) surf_h(0)%rib 4261 CASE ( 'surf_h(0)%pt_surface' ) 4262 IF ( ALLOCATED( surf_h(0)%pt_surface ) .AND. kk == 1 ) & 4263 READ ( 13 ) surf_h(0)%pt_surface 4264 CASE ( 'surf_h(0)%q_surface' ) 4265 IF ( ALLOCATED( surf_h(0)%q_surface ) .AND. kk == 1 ) & 4266 READ ( 13 ) surf_h(0)%q_surface 4267 CASE ( 'surf_h(0)%vpt_surface' ) 4268 IF ( ALLOCATED( surf_h(0)%vpt_surface ) .AND. kk == 1 ) & 4269 READ ( 13 ) surf_h(0)%vpt_surface 4270 CASE ( 'surf_h(0)%usws' ) 4271 IF ( ALLOCATED( surf_h(0)%usws ) .AND. kk == 1 ) & 4272 READ ( 13 ) surf_h(0)%usws 4273 CASE ( 'surf_h(0)%vsws' ) 4274 IF ( ALLOCATED( surf_h(0)%vsws ) .AND. kk == 1 ) & 4275 READ ( 13 ) surf_h(0)%vsws 4276 CASE ( 'surf_h(0)%shf' ) 4277 IF ( ALLOCATED( surf_h(0)%shf ) .AND. kk == 1 ) & 4278 READ ( 13 ) surf_h(0)%shf 4279 CASE ( 'surf_h(0)%qsws' ) 4280 IF ( ALLOCATED( surf_h(0)%qsws ) .AND. kk == 1 ) & 4281 READ ( 13 ) surf_h(0)%qsws 4282 CASE ( 'surf_h(0)%ssws' ) 4283 IF ( ALLOCATED( surf_h(0)%ssws ) .AND. kk == 1 ) & 4284 READ ( 13 ) surf_h(0)%ssws 4285 CASE ( 'surf_h(0)%css' ) 4286 IF ( ALLOCATED( surf_h(0)%css ) .AND. kk == 1 ) & 4287 READ ( 13 ) surf_h(0)%css 4288 CASE ( 'surf_h(0)%cssws' ) 4289 IF ( ALLOCATED( surf_h(0)%cssws ) .AND. kk == 1 ) & 4290 READ ( 13 ) surf_h(0)%cssws 4291 CASE ( 'surf_h(0)%qcsws' ) 4292 IF ( ALLOCATED( surf_h(0)%qcsws ) .AND. kk == 1 ) & 4293 READ ( 13 ) surf_h(0)%qcsws 4294 CASE ( 'surf_h(0)%ncsws' ) 4295 IF ( ALLOCATED( surf_h(0)%ncsws ) .AND. kk == 1 ) & 4296 READ ( 13 ) surf_h(0)%ncsws 4297 CASE ( 'surf_h(0)%qisws' ) 4298 IF ( ALLOCATED( surf_h(0)%qisws ) .AND. kk == 1 ) & 4299 READ ( 13 ) surf_h(0)%qisws 4300 CASE ( 'surf_h(0)%nisws' ) 4301 IF ( ALLOCATED( surf_h(0)%nisws ) .AND. kk == 1 ) & 4302 READ ( 13 ) surf_h(0)%nisws 4303 CASE ( 'surf_h(0)%qrsws' ) 4304 IF ( ALLOCATED( surf_h(0)%qrsws ) .AND. kk == 1 ) & 4305 READ ( 13 ) surf_h(0)%qrsws 4306 CASE ( 'surf_h(0)%nrsws' ) 4307 IF ( ALLOCATED( surf_h(0)%nrsws ) .AND. kk == 1 ) & 4308 READ ( 13 ) surf_h(0)%nrsws 4309 CASE ( 'surf_h(0)%sasws' ) 4310 IF ( ALLOCATED( surf_h(0)%sasws ) .AND. kk == 1 ) & 4311 READ ( 13 ) surf_h(0)%sasws 4312 CASE ( 'surf_h(1)%start_index' ) 4313 IF ( kk == 1 ) & 4314 READ ( 13 ) surf_h(1)%start_index 4315 l = 1 4316 CASE ( 'surf_h(1)%end_index' ) 4317 IF ( kk == 1 ) & 4318 READ ( 13 ) surf_h(1)%end_index 4319 CASE ( 'surf_h(1)%us' ) 4320 IF ( ALLOCATED( surf_h(1)%us ) .AND. kk == 1 ) & 4321 READ ( 13 ) surf_h(1)%us 4322 CASE ( 'surf_h(1)%ts' ) 4323 IF ( ALLOCATED( surf_h(1)%ts ) .AND. kk == 1 ) & 4324 READ ( 13 ) surf_h(1)%ts 4325 CASE ( 'surf_h(1)%qs' ) 4326 IF ( ALLOCATED( surf_h(1)%qs ) .AND. kk == 1 ) & 4327 READ ( 13 ) surf_h(1)%qs 4328 CASE ( 'surf_h(1)%ss' ) 4329 IF ( ALLOCATED( surf_h(1)%ss ) .AND. kk == 1 ) & 4330 READ ( 13 ) surf_h(1)%ss 4331 CASE ( 'surf_h(1)%qcs' ) 4332 IF ( ALLOCATED( surf_h(1)%qcs ) .AND. kk == 1 ) & 4333 READ ( 13 ) surf_h(1)%qcs 4334 CASE ( 'surf_h(1)%ncs' ) 4335 IF ( ALLOCATED( surf_h(1)%ncs ) .AND. kk == 1 ) & 4336 READ ( 13 ) surf_h(1)%ncs 4337 CASE ( 'surf_h(1)%qis' ) 4338 IF ( ALLOCATED( surf_h(1)%qis ) .AND. kk == 1 ) & 4339 READ ( 13 ) surf_h(1)%qis 4340 CASE ( 'surf_h(1)%nis' ) 4341 IF ( ALLOCATED( surf_h(1)%nis ) .AND. kk == 1 ) & 4342 READ ( 13 ) surf_h(1)%nis 4343 CASE ( 'surf_h(1)%qrs' ) 4344 IF ( ALLOCATED( surf_h(1)%qrs ) .AND. kk == 1 ) & 4345 READ ( 13 ) surf_h(1)%qrs 4346 CASE ( 'surf_h(1)%nrs' ) 4347 IF ( ALLOCATED( surf_h(1)%nrs ) .AND. kk == 1 ) & 4348 READ ( 13 ) surf_h(1)%nrs 4349 CASE ( 'surf_h(1)%ol' ) 4350 IF ( ALLOCATED( surf_h(1)%ol ) .AND. kk == 1 ) & 4351 READ ( 13 ) surf_h(1)%ol 4352 CASE ( 'surf_h(1)%rib' ) 4353 IF ( ALLOCATED( surf_h(1)%rib ) .AND. kk == 1 ) & 4354 READ ( 13 ) surf_h(1)%rib 4355 CASE ( 'surf_h(1)%pt_surface' ) 4356 IF ( ALLOCATED( surf_h(1)%pt_surface ) .AND. kk == 1 ) & 4357 READ ( 13 ) surf_h(1)%pt_surface 4358 CASE ( 'surf_h(1)%q_surface' ) 4359 IF ( ALLOCATED( surf_h(1)%q_surface ) .AND. kk == 1 ) & 4360 READ ( 13 ) surf_h(1)%q_surface 4361 CASE ( 'surf_h(1)%vpt_surface' ) 4362 IF ( ALLOCATED( surf_h(1)%vpt_surface ) .AND. kk == 1 ) & 4363 READ ( 13 ) surf_h(1)%vpt_surface 4364 CASE ( 'surf_h(1)%usws' ) 4365 IF ( ALLOCATED( surf_h(1)%usws ) .AND. kk == 1 ) & 4366 READ ( 13 ) surf_h(1)%usws 4367 CASE ( 'surf_h(1)%vsws' ) 4368 IF ( ALLOCATED( surf_h(1)%vsws ) .AND. kk == 1 ) & 4369 READ ( 13 ) surf_h(1)%vsws 4370 CASE ( 'surf_h(1)%shf' ) 4371 IF ( ALLOCATED( surf_h(1)%shf ) .AND. kk == 1 ) & 4372 READ ( 13 ) surf_h(1)%shf 4373 CASE ( 'surf_h(1)%qsws' ) 4374 IF ( ALLOCATED( surf_h(1)%qsws ) .AND. kk == 1 ) & 4375 READ ( 13 ) surf_h(1)%qsws 4376 CASE ( 'surf_h(1)%ssws' ) 4377 IF ( ALLOCATED( surf_h(1)%ssws ) .AND. kk == 1 ) & 4378 READ ( 13 ) surf_h(1)%ssws 4379 CASE ( 'surf_h(1)%css' ) 4380 IF ( ALLOCATED( surf_h(1)%css ) .AND. kk == 1 ) & 4381 READ ( 13 ) surf_h(1)%css 4382 CASE ( 'surf_h(1)%cssws' ) 4383 IF ( ALLOCATED( surf_h(1)%cssws ) .AND. kk == 1 ) & 4384 READ ( 13 ) surf_h(1)%cssws 4385 CASE ( 'surf_h(1)%qcsws' ) 4386 IF ( ALLOCATED( surf_h(1)%qcsws ) .AND. kk == 1 ) & 4387 READ ( 13 ) surf_h(1)%qcsws 4388 CASE ( 'surf_h(1)%ncsws' ) 4389 IF ( ALLOCATED( surf_h(1)%ncsws ) .AND. kk == 1 ) & 4390 READ ( 13 ) surf_h(1)%ncsws 4391 CASE ( 'surf_h(1)%qisws' ) 4392 IF ( ALLOCATED( surf_h(1)%qisws ) .AND. kk == 1 ) & 4393 READ ( 13 ) surf_h(1)%qisws 4394 CASE ( 'surf_h(1)%nisws' ) 4395 IF ( ALLOCATED( surf_h(1)%nisws ) .AND. kk == 1 ) & 4396 READ ( 13 ) surf_h(1)%nisws 4397 CASE ( 'surf_h(1)%qrsws' ) 4398 IF ( ALLOCATED( surf_h(1)%qrsws ) .AND. kk == 1 ) & 4399 READ ( 13 ) surf_h(1)%qrsws 4400 CASE ( 'surf_h(1)%nrsws' ) 4401 IF ( ALLOCATED( surf_h(1)%nrsws ) .AND. kk == 1 ) & 4402 READ ( 13 ) surf_h(1)%nrsws 4403 CASE ( 'surf_h(1)%sasws' ) 4404 IF ( ALLOCATED( surf_h(1)%sasws ) .AND. kk == 1 ) & 4405 READ ( 13 ) surf_h(1)%sasws 4406 CASE ( 'surf_h(2)%start_index' ) 4407 IF ( kk == 1 ) & 4408 READ ( 13 ) surf_h(2)%start_index 4409 l = 2 4410 CASE ( 'surf_h(2)%end_index' ) 4411 IF ( kk == 1 ) & 4412 READ ( 13 ) surf_h(2)%end_index 4413 CASE ( 'surf_h(2)%us' ) 4414 IF ( ALLOCATED( surf_h(2)%us ) .AND. kk == 1 ) & 4415 READ ( 13 ) surf_h(2)%us 4416 CASE ( 'surf_h(2)%ts' ) 4417 IF ( ALLOCATED( surf_h(2)%ts ) .AND. kk == 1 ) & 4418 READ ( 13 ) surf_h(2)%ts 4419 CASE ( 'surf_h(2)%qs' ) 4420 IF ( ALLOCATED( surf_h(2)%qs ) .AND. kk == 1 ) & 4421 READ ( 13 ) surf_h(2)%qs 4422 CASE ( 'surf_h(2)%ss' ) 4423 IF ( ALLOCATED( surf_h(2)%ss ) .AND. kk == 1 ) & 4424 READ ( 13 ) surf_h(2)%ss 4425 CASE ( 'surf_h(2)%qcs' ) 4426 IF ( ALLOCATED( surf_h(2)%qcs ) .AND. kk == 1 ) & 4427 READ ( 13 ) surf_h(2)%qcs 4428 CASE ( 'surf_h(2)%ncs' ) 4429 IF ( ALLOCATED( surf_h(2)%ncs ) .AND. kk == 1 ) & 4430 READ ( 13 ) surf_h(2)%ncs 4431 CASE ( 'surf_h(2)%qis' ) 4432 IF ( ALLOCATED( surf_h(2)%qis ) .AND. kk == 1 ) & 4433 READ ( 13 ) surf_h(2)%qis 4434 CASE ( 'surf_h(2)%nis' ) 4435 IF ( ALLOCATED( surf_h(2)%nis ) .AND. kk == 1 ) & 4436 READ ( 13 ) surf_h(2)%nis 4437 CASE ( 'surf_h(2)%qrs' ) 4438 IF ( ALLOCATED( surf_h(2)%qrs ) .AND. kk == 1 ) & 4439 READ ( 13 ) surf_h(2)%qrs 4440 CASE ( 'surf_h(2)%nrs' ) 4441 IF ( ALLOCATED( surf_h(2)%nrs ) .AND. kk == 1 ) & 4442 READ ( 13 ) surf_h(2)%nrs 4443 CASE ( 'surf_h(2)%ol' ) 4444 IF ( ALLOCATED( surf_h(2)%ol ) .AND. kk == 1 ) & 4445 READ ( 13 ) surf_h(2)%ol 4446 CASE ( 'surf_h(2)%rib' ) 4447 IF ( ALLOCATED( surf_h(2)%rib ) .AND. kk == 1 ) & 4448 READ ( 13 ) surf_h(2)%rib 4449 CASE ( 'surf_h(2)%pt_surface' ) 4450 IF ( ALLOCATED( surf_h(2)%pt_surface ) .AND. kk == 1 ) & 4451 READ ( 13 ) surf_h(2)%pt_surface 4452 CASE ( 'surf_h(2)%q_surface' ) 4453 IF ( ALLOCATED( surf_h(2)%q_surface ) .AND. kk == 1 ) & 4454 READ ( 13 ) surf_h(2)%q_surface 4455 CASE ( 'surf_h(2)%vpt_surface' ) 4456 IF ( ALLOCATED( surf_h(2)%vpt_surface ) .AND. kk == 1 ) & 4457 READ ( 13 ) surf_h(2)%vpt_surface 4458 CASE ( 'surf_h(2)%usws' ) 4459 IF ( ALLOCATED( surf_h(2)%usws ) .AND. kk == 1 ) & 4460 READ ( 13 ) surf_h(2)%usws 4461 CASE ( 'surf_h(2)%vsws' ) 4462 IF ( ALLOCATED( surf_h(2)%vsws ) .AND. kk == 1 ) & 4463 READ ( 13 ) surf_h(2)%vsws 4464 CASE ( 'surf_h(2)%shf' ) 4465 IF ( ALLOCATED( surf_h(2)%shf ) .AND. kk == 1 ) & 4466 READ ( 13 ) surf_h(2)%shf 4467 CASE ( 'surf_h(2)%qsws' ) 4468 IF ( ALLOCATED( surf_h(2)%qsws ) .AND. kk == 1 ) & 4469 READ ( 13 ) surf_h(2)%qsws 4470 CASE ( 'surf_h(2)%ssws' ) 4471 IF ( ALLOCATED( surf_h(2)%ssws ) .AND. kk == 1 ) & 4472 READ ( 13 ) surf_h(2)%ssws 4473 CASE ( 'surf_h(2)%css' ) 4474 IF ( ALLOCATED( surf_h(2)%css ) .AND. kk == 1 ) & 4475 READ ( 13 ) surf_h(2)%css 4476 CASE ( 'surf_h(2)%cssws' ) 4477 IF ( ALLOCATED( surf_h(2)%cssws ) .AND. kk == 1 ) & 4478 READ ( 13 ) surf_h(2)%cssws 4479 CASE ( 'surf_h(2)%qcsws' ) 4480 IF ( ALLOCATED( surf_h(2)%qcsws ) .AND. kk == 1 ) & 4481 READ ( 13 ) surf_h(2)%qcsws 4482 CASE ( 'surf_h(2)%ncsws' ) 4483 IF ( ALLOCATED( surf_h(2)%ncsws ) .AND. kk == 1 ) & 4484 READ ( 13 ) surf_h(2)%ncsws 4485 CASE ( 'surf_h(2)%qisws' ) 4486 IF ( ALLOCATED( surf_h(2)%qisws ) .AND. kk == 1 ) & 4487 READ ( 13 ) surf_h(2)%qisws 4488 CASE ( 'surf_h(2)%nisws' ) 4489 IF ( ALLOCATED( surf_h(2)%nisws ) .AND. kk == 1 ) & 4490 READ ( 13 ) surf_h(2)%nisws 4491 CASE ( 'surf_h(2)%qrsws' ) 4492 IF ( ALLOCATED( surf_h(2)%qrsws ) .AND. kk == 1 ) & 4493 READ ( 13 ) surf_h(2)%qrsws 4494 CASE ( 'surf_h(2)%nrsws' ) 4495 IF ( ALLOCATED( surf_h(2)%nrsws ) .AND. kk == 1 ) & 4496 READ ( 13 ) surf_h(2)%nrsws 4497 CASE ( 'surf_h(2)%sasws' ) 4498 IF ( ALLOCATED( surf_h(2)%sasws ) .AND. kk == 1 ) & 4499 READ ( 13 ) surf_h(2)%sasws 4500 4501 CASE ( 'surf_v(0)%start_index' ) 4502 IF ( kk == 1 ) & 4503 READ ( 13 ) surf_v(0)%start_index 4504 l = 0 4505 horizontal_surface = .FALSE. 4506 vertical_surface = .TRUE. 4507 CASE ( 'surf_v(0)%end_index' ) 4508 IF ( kk == 1 ) & 4509 READ ( 13 ) surf_v(0)%end_index 4510 CASE ( 'surf_v(0)%us' ) 4511 IF ( ALLOCATED( surf_v(0)%us ) .AND. kk == 1 ) & 4512 READ ( 13 ) surf_v(0)%us 4513 CASE ( 'surf_v(0)%ts' ) 4514 IF ( ALLOCATED( surf_v(0)%ts ) .AND. kk == 1 ) & 4515 READ ( 13 ) surf_v(0)%ts 4516 CASE ( 'surf_v(0)%qs' ) 4517 IF ( ALLOCATED( surf_v(0)%qs ) .AND. kk == 1 ) & 4518 READ ( 13 ) surf_v(0)%qs 4519 CASE ( 'surf_v(0)%ss' ) 4520 IF ( ALLOCATED( surf_v(0)%ss ) .AND. kk == 1 ) & 4521 READ ( 13 ) surf_v(0)%ss 4522 CASE ( 'surf_v(0)%qcs' ) 4523 IF ( ALLOCATED( surf_v(0)%qcs ) .AND. kk == 1 ) & 4524 READ ( 13 ) surf_v(0)%qcs 4525 CASE ( 'surf_v(0)%ncs' ) 4526 IF ( ALLOCATED( surf_v(0)%ncs ) .AND. kk == 1 ) & 4527 READ ( 13 ) surf_v(0)%ncs 4528 CASE ( 'surf_v(0)%qis' ) 4529 IF ( ALLOCATED( surf_v(0)%qis ) .AND. kk == 1 ) & 4530 READ ( 13 ) surf_v(0)%qis 4531 CASE ( 'surf_v(0)%nis' ) 4532 IF ( ALLOCATED( surf_v(0)%nis ) .AND. kk == 1 ) & 4533 READ ( 13 ) surf_v(0)%nis 4534 CASE ( 'surf_v(0)%qrs' ) 4535 IF ( ALLOCATED( surf_v(0)%qrs ) .AND. kk == 1 ) & 4536 READ ( 13 ) surf_v(0)%qrs 4537 CASE ( 'surf_v(0)%nrs' ) 4538 IF ( ALLOCATED( surf_v(0)%nrs ) .AND. kk == 1 ) & 4539 READ ( 13 ) surf_v(0)%nrs 4540 CASE ( 'surf_v(0)%ol' ) 4541 IF ( ALLOCATED( surf_v(0)%ol ) .AND. kk == 1 ) & 4542 READ ( 13 ) surf_v(0)%ol 4543 CASE ( 'surf_v(0)%rib' ) 4544 IF ( ALLOCATED( surf_v(0)%rib ) .AND. kk == 1 ) & 4545 READ ( 13 ) surf_v(0)%rib 4546 CASE ( 'surf_v(0)%pt_surface' ) 4547 IF ( ALLOCATED( surf_v(0)%pt_surface ) .AND. kk == 1 ) & 4548 READ ( 13 ) surf_v(0)%pt_surface 4549 CASE ( 'surf_v(0)%q_surface' ) 4550 IF ( ALLOCATED( surf_v(0)%q_surface ) .AND. kk == 1 ) & 4551 READ ( 13 ) surf_v(0)%q_surface 4552 CASE ( 'surf_v(0)%vpt_surface' ) 4553 IF ( ALLOCATED( surf_v(0)%vpt_surface ) .AND. kk == 1 ) & 4554 READ ( 13 ) surf_v(0)%vpt_surface 4555 CASE ( 'surf_v(0)%shf' ) 4556 IF ( ALLOCATED( surf_v(0)%shf ) .AND. kk == 1 ) & 4557 READ ( 13 ) surf_v(0)%shf 4558 CASE ( 'surf_v(0)%qsws' ) 4559 IF ( ALLOCATED( surf_v(0)%qsws ) .AND. kk == 1 ) & 4560 READ ( 13 ) surf_v(0)%qsws 4561 CASE ( 'surf_v(0)%ssws' ) 4562 IF ( ALLOCATED( surf_v(0)%ssws ) .AND. kk == 1 ) & 4563 READ ( 13 ) surf_v(0)%ssws 4564 CASE ( 'surf_v(0)%css' ) 4565 IF ( ALLOCATED( surf_v(0)%css ) .AND. kk == 1 ) & 4566 READ ( 13 ) surf_v(0)%css 4567 CASE ( 'surf_v(0)%cssws' ) 4568 IF ( ALLOCATED( surf_v(0)%cssws ) .AND. kk == 1 ) & 4569 READ ( 13 ) surf_v(0)%cssws 4570 CASE ( 'surf_v(0)%qcsws' ) 4571 IF ( ALLOCATED( surf_v(0)%qcsws ) .AND. kk == 1 ) & 4572 READ ( 13 ) surf_v(0)%qcsws 4573 CASE ( 'surf_v(0)%ncsws' ) 4574 IF ( ALLOCATED( surf_v(0)%ncsws ) .AND. kk == 1 ) & 4575 READ ( 13 ) surf_v(0)%ncsws 4576 CASE ( 'surf_v(0)%qisws' ) 4577 IF ( ALLOCATED( surf_v(0)%qisws ) .AND. kk == 1 ) & 4578 READ ( 13 ) surf_v(0)%qisws 4579 CASE ( 'surf_v(0)%nisws' ) 4580 IF ( ALLOCATED( surf_v(0)%nisws ) .AND. kk == 1 ) & 4581 READ ( 13 ) surf_v(0)%nisws 4582 CASE ( 'surf_v(0)%qrsws' ) 4583 IF ( ALLOCATED( surf_v(0)%qrsws ) .AND. kk == 1 ) & 4584 READ ( 13 ) surf_v(0)%qrsws 4585 CASE ( 'surf_v(0)%nrsws' ) 4586 IF ( ALLOCATED( surf_v(0)%nrsws ) .AND. kk == 1 ) & 4587 READ ( 13 ) surf_v(0)%nrsws 4588 CASE ( 'surf_v(0)%sasws' ) 4589 IF ( ALLOCATED( surf_v(0)%sasws ) .AND. kk == 1 ) & 4590 READ ( 13 ) surf_v(0)%sasws 4591 CASE ( 'surf_v(0)%mom_uv' ) 4592 IF ( ALLOCATED( surf_v(0)%mom_flux_uv ) .AND. kk == 1 ) & 4593 READ ( 13 ) surf_v(0)%mom_flux_uv 4594 CASE ( 'surf_v(0)%mom_w' ) 4595 IF ( ALLOCATED( surf_v(0)%mom_flux_w ) .AND. kk == 1 ) & 4596 READ ( 13 ) surf_v(0)%mom_flux_w 4597 CASE ( 'surf_v(0)%mom_tke' ) 4598 IF ( ALLOCATED( surf_v(0)%mom_flux_tke ) .AND. kk == 1 ) & 4599 READ ( 13 ) surf_v(0)%mom_flux_tke 4600 CASE ( 'surf_v(1)%start_index' ) 4601 IF ( kk == 1 ) & 4602 READ ( 13 ) surf_v(1)%start_index 4603 l = 1 4604 CASE ( 'surf_v(1)%end_index' ) 4605 IF ( kk == 1 ) & 4606 READ ( 13 ) surf_v(1)%end_index 4607 CASE ( 'surf_v(1)%us' ) 4608 IF ( ALLOCATED( surf_v(1)%us ) .AND. kk == 1 ) & 4609 READ ( 13 ) surf_v(1)%us 4610 CASE ( 'surf_v(1)%ts' ) 4611 IF ( ALLOCATED( surf_v(1)%ts ) .AND. kk == 1 ) & 4612 READ ( 13 ) surf_v(1)%ts 4613 CASE ( 'surf_v(1)%qs' ) 4614 IF ( ALLOCATED( surf_v(1)%qs ) .AND. kk == 1 ) & 4615 READ ( 13 ) surf_v(1)%qs 4616 CASE ( 'surf_v(1)%ss' ) 4617 IF ( ALLOCATED( surf_v(1)%ss ) .AND. kk == 1 ) & 4618 READ ( 13 ) surf_v(1)%ss 4619 CASE ( 'surf_v(1)%qcs' ) 4620 IF ( ALLOCATED( surf_v(1)%qcs ) .AND. kk == 1 ) & 4621 READ ( 13 ) surf_v(1)%qcs 4622 CASE ( 'surf_v(1)%ncs' ) 4623 IF ( ALLOCATED( surf_v(1)%ncs ) .AND. kk == 1 ) & 4624 READ ( 13 ) surf_v(1)%ncs 4625 CASE ( 'surf_v(1)%qis' ) 4626 IF ( ALLOCATED( surf_v(1)%qis ) .AND. kk == 1 ) & 4627 READ ( 13 ) surf_v(1)%qis 4628 CASE ( 'surf_v(1)%nis' ) 4629 IF ( ALLOCATED( surf_v(1)%nis ) .AND. kk == 1 ) & 4630 READ ( 13 ) surf_v(1)%nis 4631 CASE ( 'surf_v(1)%qrs' ) 4632 IF ( ALLOCATED( surf_v(1)%qrs ) .AND. kk == 1 ) & 4633 READ ( 13 ) surf_v(1)%qrs 4634 CASE ( 'surf_v(1)%nrs' ) 4635 IF ( ALLOCATED( surf_v(1)%nrs ) .AND. kk == 1 ) & 4636 READ ( 13 ) surf_v(1)%nrs 4637 CASE ( 'surf_v(1)%ol' ) 4638 IF ( ALLOCATED( surf_v(1)%ol ) .AND. kk == 1 ) & 4639 READ ( 13 ) surf_v(1)%ol 4640 CASE ( 'surf_v(1)%rib' ) 4641 IF ( ALLOCATED( surf_v(1)%rib ) .AND. kk == 1 ) & 4642 READ ( 13 ) surf_v(1)%rib 4643 CASE ( 'surf_v(1)%pt_surface' ) 4644 IF ( ALLOCATED( surf_v(1)%pt_surface ) .AND. kk == 1 ) & 4645 READ ( 13 ) surf_v(1)%pt_surface 4646 CASE ( 'surf_v(1)%q_surface' ) 4647 IF ( ALLOCATED( surf_v(1)%q_surface ) .AND. kk == 1 ) & 4648 READ ( 13 ) surf_v(1)%q_surface 4649 CASE ( 'surf_v(1)%vpt_surface' ) 4650 IF ( ALLOCATED( surf_v(1)%vpt_surface ) .AND. kk == 1 ) & 4651 READ ( 13 ) surf_v(1)%vpt_surface 4652 CASE ( 'surf_v(1)%shf' ) 4653 IF ( ALLOCATED( surf_v(1)%shf ) .AND. kk == 1 ) & 4654 READ ( 13 ) surf_v(1)%shf 4655 CASE ( 'surf_v(1)%qsws' ) 4656 IF ( ALLOCATED( surf_v(1)%qsws ) .AND. kk == 1 ) & 4657 READ ( 13 ) surf_v(1)%qsws 4658 CASE ( 'surf_v(1)%ssws' ) 4659 IF ( ALLOCATED( surf_v(1)%ssws ) .AND. kk == 1 ) & 4660 READ ( 13 ) surf_v(1)%ssws 4661 CASE ( 'surf_v(1)%css' ) 4662 IF ( ALLOCATED( surf_v(1)%css ) .AND. kk == 1 ) & 4663 READ ( 13 ) surf_v(1)%css 4664 CASE ( 'surf_v(1)%cssws' ) 4665 IF ( ALLOCATED( surf_v(1)%cssws ) .AND. kk == 1 ) & 4666 READ ( 13 ) surf_v(1)%cssws 4667 CASE ( 'surf_v(1)%qcsws' ) 4668 IF ( ALLOCATED( surf_v(1)%qcsws ) .AND. kk == 1 ) & 4669 READ ( 13 ) surf_v(1)%qcsws 4670 CASE ( 'surf_v(1)%ncsws' ) 4671 IF ( ALLOCATED( surf_v(1)%ncsws ) .AND. kk == 1 ) & 4672 READ ( 13 ) surf_v(1)%ncsws 4673 CASE ( 'surf_v(1)%qisws' ) 4674 IF ( ALLOCATED( surf_v(1)%qisws ) .AND. kk == 1 ) & 4675 READ ( 13 ) surf_v(1)%qisws 4676 CASE ( 'surf_v(1)%nisws' ) 4677 IF ( ALLOCATED( surf_v(1)%nisws ) .AND. kk == 1 ) & 4678 READ ( 13 ) surf_v(1)%nisws 4679 CASE ( 'surf_v(1)%qrsws' ) 4680 IF ( ALLOCATED( surf_v(1)%qrsws ) .AND. kk == 1 ) & 4681 READ ( 13 ) surf_v(1)%qrsws 4682 CASE ( 'surf_v(1)%nrsws' ) 4683 IF ( ALLOCATED( surf_v(1)%nrsws ) .AND. kk == 1 ) & 4684 READ ( 13 ) surf_v(1)%nrsws 4685 CASE ( 'surf_v(1)%sasws' ) 4686 IF ( ALLOCATED( surf_v(1)%sasws ) .AND. kk == 1 ) & 4687 READ ( 13 ) surf_v(1)%sasws 4688 CASE ( 'surf_v(1)%mom_uv' ) 4689 IF ( ALLOCATED( surf_v(1)%mom_flux_uv ) .AND. kk == 1 ) & 4690 READ ( 13 ) surf_v(1)%mom_flux_uv 4691 CASE ( 'surf_v(1)%mom_w' ) 4692 IF ( ALLOCATED( surf_v(1)%mom_flux_w ) .AND. kk == 1 ) & 4693 READ ( 13 ) surf_v(1)%mom_flux_w 4694 CASE ( 'surf_v(1)%mom_tke' ) 4695 IF ( ALLOCATED( surf_v(1)%mom_flux_tke ) .AND. kk == 1 ) & 4696 READ ( 13 ) surf_v(1)%mom_flux_tke 4697 CASE ( 'surf_v(2)%start_index' ) 4698 IF ( kk == 1 ) & 4699 READ ( 13 ) surf_v(2)%start_index 4700 l = 2 4701 CASE ( 'surf_v(2)%end_index' ) 4702 IF ( kk == 1 ) & 4703 READ ( 13 ) surf_v(2)%end_index 4704 CASE ( 'surf_v(2)%us' ) 4705 IF ( ALLOCATED( surf_v(2)%us ) .AND. kk == 1 ) & 4706 READ ( 13 ) surf_v(2)%us 4707 CASE ( 'surf_v(2)%ts' ) 4708 IF ( ALLOCATED( surf_v(2)%ts ) .AND. kk == 1 ) & 4709 READ ( 13 ) surf_v(2)%ts 4710 CASE ( 'surf_v(2)%qs' ) 4711 IF ( ALLOCATED( surf_v(2)%qs ) .AND. kk == 1 ) & 4712 READ ( 13 ) surf_v(2)%qs 4713 CASE ( 'surf_v(2)%ss' ) 4714 IF ( ALLOCATED( surf_v(2)%ss ) .AND. kk == 1 ) & 4715 READ ( 13 ) surf_v(2)%ss 4716 CASE ( 'surf_v(2)%qcs' ) 4717 IF ( ALLOCATED( surf_v(2)%qcs ) .AND. kk == 1 ) & 4718 READ ( 13 ) surf_v(2)%qcs 4719 CASE ( 'surf_v(2)%ncs' ) 4720 IF ( ALLOCATED( surf_v(2)%ncs ) .AND. kk == 1 ) & 4721 READ ( 13 ) surf_v(2)%ncs 4722 CASE ( 'surf_v(2)%qis' ) 4723 IF ( ALLOCATED( surf_v(2)%qis ) .AND. kk == 1 ) & 4724 READ ( 13 ) surf_v(2)%qis 4725 CASE ( 'surf_v(2)%nis' ) 4726 IF ( ALLOCATED( surf_v(2)%nis ) .AND. kk == 1 ) & 4727 READ ( 13 ) surf_v(2)%nis 4728 CASE ( 'surf_v(2)%qrs' ) 4729 IF ( ALLOCATED( surf_v(2)%qrs ) .AND. kk == 1 ) & 4730 READ ( 13 ) surf_v(2)%qrs 4731 CASE ( 'surf_v(2)%nrs' ) 4732 IF ( ALLOCATED( surf_v(2)%nrs ) .AND. kk == 1 ) & 4733 READ ( 13 ) surf_v(2)%nrs 4734 CASE ( 'surf_v(2)%ol' ) 4735 IF ( ALLOCATED( surf_v(2)%ol ) .AND. kk == 1 ) & 4736 READ ( 13 ) surf_v(2)%ol 4737 CASE ( 'surf_v(2)%rib' ) 4738 IF ( ALLOCATED( surf_v(2)%rib ) .AND. kk == 1 ) & 4739 READ ( 13 ) surf_v(2)%rib 4740 CASE ( 'surf_v(2)%pt_surface' ) 4741 IF ( ALLOCATED( surf_v(2)%pt_surface ) .AND. kk == 1 ) & 4742 READ ( 13 ) surf_v(2)%pt_surface 4743 CASE ( 'surf_v(2)%q_surface' ) 4744 IF ( ALLOCATED( surf_v(2)%q_surface ) .AND. kk == 1 ) & 4745 READ ( 13 ) surf_v(2)%q_surface 4746 CASE ( 'surf_v(2)%vpt_surface' ) 4747 IF ( ALLOCATED( surf_v(2)%vpt_surface ) .AND. kk == 1 ) & 4748 READ ( 13 ) surf_v(2)%vpt_surface 4749 CASE ( 'surf_v(2)%shf' ) 4750 IF ( ALLOCATED( surf_v(2)%shf ) .AND. kk == 1 ) & 4751 READ ( 13 ) surf_v(2)%shf 4752 CASE ( 'surf_v(2)%qsws' ) 4753 IF ( ALLOCATED( surf_v(2)%qsws ) .AND. kk == 1 ) & 4754 READ ( 13 ) surf_v(2)%qsws 4755 CASE ( 'surf_v(2)%ssws' ) 4756 IF ( ALLOCATED( surf_v(2)%ssws ) .AND. kk == 1 ) & 4757 READ ( 13 ) surf_v(2)%ssws 4758 CASE ( 'surf_v(2)%css' ) 4759 IF ( ALLOCATED( surf_v(2)%css ) .AND. kk == 1 ) & 4760 READ ( 13 ) surf_v(2)%css 4761 CASE ( 'surf_v(2)%cssws' ) 4762 IF ( ALLOCATED( surf_v(2)%cssws ) .AND. kk == 1 ) & 4763 READ ( 13 ) surf_v(2)%cssws 4764 CASE ( 'surf_v(2)%qcsws' ) 4765 IF ( ALLOCATED( surf_v(2)%qcsws ) .AND. kk == 1 ) & 4766 READ ( 13 ) surf_v(2)%qcsws 4767 CASE ( 'surf_v(2)%ncsws' ) 4768 IF ( ALLOCATED( surf_v(2)%ncsws ) .AND. kk == 1 ) & 4769 READ ( 13 ) surf_v(2)%ncsws 4770 CASE ( 'surf_v(2)%qisws' ) 4771 IF ( ALLOCATED( surf_v(2)%qisws ) .AND. kk == 1 ) & 4772 READ ( 13 ) surf_v(2)%qisws 4773 CASE ( 'surf_v(2)%nisws' ) 4774 IF ( ALLOCATED( surf_v(2)%nisws ) .AND. kk == 1 ) & 4775 READ ( 13 ) surf_v(2)%nisws 4776 CASE ( 'surf_v(2)%qrsws' ) 4777 IF ( ALLOCATED( surf_v(2)%qrsws ) .AND. kk == 1 ) & 4778 READ ( 13 ) surf_v(2)%qrsws 4779 CASE ( 'surf_v(2)%nrsws' ) 4780 IF ( ALLOCATED( surf_v(2)%nrsws ) .AND. kk == 1 ) & 4781 READ ( 13 ) surf_v(2)%nrsws 4782 CASE ( 'surf_v(2)%sasws' ) 4783 IF ( ALLOCATED( surf_v(2)%sasws ) .AND. kk == 1 ) & 4784 READ ( 13 ) surf_v(2)%sasws 4785 CASE ( 'surf_v(2)%mom_uv' ) 4786 IF ( ALLOCATED( surf_v(2)%mom_flux_uv ) .AND. kk == 1 ) & 4787 READ ( 13 ) surf_v(2)%mom_flux_uv 4788 CASE ( 'surf_v(2)%mom_w' ) 4789 IF ( ALLOCATED( surf_v(2)%mom_flux_w ) .AND. kk == 1 ) & 4790 READ ( 13 ) surf_v(2)%mom_flux_w 4791 CASE ( 'surf_v(2)%mom_tke' ) 4792 IF ( ALLOCATED( surf_v(2)%mom_flux_tke ) .AND. kk == 1 ) & 4793 READ ( 13 ) surf_v(2)%mom_flux_tke 4794 CASE ( 'surf_v(3)%start_index' ) 4795 IF ( kk == 1 ) & 4796 READ ( 13 ) surf_v(3)%start_index 4797 l = 3 4798 CASE ( 'surf_v(3)%end_index' ) 4799 IF ( kk == 1 ) & 4800 READ ( 13 ) surf_v(3)%end_index 4801 CASE ( 'surf_v(3)%us' ) 4802 IF ( ALLOCATED( surf_v(3)%us ) .AND. kk == 1 ) & 4803 READ ( 13 ) surf_v(3)%us 4804 CASE ( 'surf_v(3)%ts' ) 4805 IF ( ALLOCATED( surf_v(3)%ts ) .AND. kk == 1 ) & 4806 READ ( 13 ) surf_v(3)%ts 4807 CASE ( 'surf_v(3)%qs' ) 4808 IF ( ALLOCATED( surf_v(3)%qs ) .AND. kk == 1 ) & 4809 READ ( 13 ) surf_v(3)%qs 4810 CASE ( 'surf_v(3)%ss' ) 4811 IF ( ALLOCATED( surf_v(3)%ss ) .AND. kk == 1 ) & 4812 READ ( 13 ) surf_v(3)%ss 4813 CASE ( 'surf_v(3)%qcs' ) 4814 IF ( ALLOCATED( surf_v(3)%qcs ) .AND. kk == 1 ) & 4815 READ ( 13 ) surf_v(3)%qcs 4816 CASE ( 'surf_v(3)%ncs' ) 4817 IF ( ALLOCATED( surf_v(3)%ncs ) .AND. kk == 1 ) & 4818 READ ( 13 ) surf_v(3)%ncs 4819 CASE ( 'surf_v(3)%qis' ) 4820 IF ( ALLOCATED( surf_v(3)%qis ) .AND. kk == 1 ) & 4821 READ ( 13 ) surf_v(3)%qis 4822 CASE ( 'surf_v(3)%nis' ) 4823 IF ( ALLOCATED( surf_v(3)%nis ) .AND. kk == 1 ) & 4824 READ ( 13 ) surf_v(3)%nis 4825 CASE ( 'surf_v(3)%qrs' ) 4826 IF ( ALLOCATED( surf_v(3)%qrs ) .AND. kk == 1 ) & 4827 READ ( 13 ) surf_v(3)%qrs 4828 CASE ( 'surf_v(3)%nrs' ) 4829 IF ( ALLOCATED( surf_v(3)%nrs ) .AND. kk == 1 ) & 4830 READ ( 13 ) surf_v(3)%nrs 4831 CASE ( 'surf_v(3)%ol' ) 4832 IF ( ALLOCATED( surf_v(3)%ol ) .AND. kk == 1 ) & 4833 READ ( 13 ) surf_v(3)%ol 4834 CASE ( 'surf_v(3)%rib' ) 4835 IF ( ALLOCATED( surf_v(3)%rib ) .AND. kk == 1 ) & 4836 READ ( 13 ) surf_v(3)%rib 4837 CASE ( 'surf_v(3)%pt_surface' ) 4838 IF ( ALLOCATED( surf_v(3)%pt_surface ) .AND. kk == 1 ) & 4839 READ ( 13 ) surf_v(3)%pt_surface 4840 CASE ( 'surf_v(3)%q_surface' ) 4841 IF ( ALLOCATED( surf_v(3)%q_surface ) .AND. kk == 1 ) & 4842 READ ( 13 ) surf_v(3)%q_surface 4843 CASE ( 'surf_v(3)%vpt_surface' ) 4844 IF ( ALLOCATED( surf_v(3)%vpt_surface ) .AND. kk == 1 ) & 4845 READ ( 13 ) surf_v(3)%vpt_surface 4846 CASE ( 'surf_v(3)%shf' ) 4847 IF ( ALLOCATED( surf_v(3)%shf ) .AND. kk == 1 ) & 4848 READ ( 13 ) surf_v(3)%shf 4849 CASE ( 'surf_v(3)%qsws' ) 4850 IF ( ALLOCATED( surf_v(3)%qsws ) .AND. kk == 1 ) & 4851 READ ( 13 ) surf_v(3)%qsws 4852 CASE ( 'surf_v(3)%ssws' ) 4853 IF ( ALLOCATED( surf_v(3)%ssws ) .AND. kk == 1 ) & 4854 READ ( 13 ) surf_v(3)%ssws 4855 CASE ( 'surf_v(3)%css' ) 4856 IF ( ALLOCATED( surf_v(3)%css ) .AND. kk == 1 ) & 4857 READ ( 13 ) surf_v(3)%css 4858 CASE ( 'surf_v(3)%cssws' ) 4859 IF ( ALLOCATED( surf_v(3)%cssws ) .AND. kk == 1 ) & 4860 READ ( 13 ) surf_v(3)%cssws 4861 CASE ( 'surf_v(3)%qcsws' ) 4862 IF ( ALLOCATED( surf_v(3)%qcsws ) .AND. kk == 1 ) & 4863 READ ( 13 ) surf_v(3)%qcsws 4864 CASE ( 'surf_v(3)%ncsws' ) 4865 IF ( ALLOCATED( surf_v(3)%ncsws ) .AND. kk == 1 ) & 4866 READ ( 13 ) surf_v(3)%ncsws 4867 CASE ( 'surf_v(3)%qisws' ) 4868 IF ( ALLOCATED( surf_v(3)%qisws ) .AND. kk == 1 ) & 4869 READ ( 13 ) surf_v(3)%qisws 4870 CASE ( 'surf_v(3)%nisws' ) 4871 IF ( ALLOCATED( surf_v(3)%nisws ) .AND. kk == 1 ) & 4872 READ ( 13 ) surf_v(3)%nisws 4873 CASE ( 'surf_v(3)%qrsws' ) 4874 IF ( ALLOCATED( surf_v(3)%qrsws ) .AND. kk == 1 ) & 4875 READ ( 13 ) surf_v(3)%qrsws 4876 CASE ( 'surf_v(3)%nrsws' ) 4877 IF ( ALLOCATED( surf_v(3)%nrsws ) .AND. kk == 1 ) & 4878 READ ( 13 ) surf_v(3)%nrsws 4879 CASE ( 'surf_v(3)%sasws' ) 4880 IF ( ALLOCATED( surf_v(3)%sasws ) .AND. kk == 1 ) & 4881 READ ( 13 ) surf_v(3)%sasws 4882 CASE ( 'surf_v(3)%mom_uv' ) 4883 IF ( ALLOCATED( surf_v(3)%mom_flux_uv ) .AND. kk == 1 ) & 4884 READ ( 13 ) surf_v(3)%mom_flux_uv 4885 CASE ( 'surf_v(3)%mom_w' ) 4886 IF ( ALLOCATED( surf_v(3)%mom_flux_w ) .AND. kk == 1 ) & 4887 READ ( 13 ) surf_v(3)%mom_flux_w 4888 CASE ( 'surf_v(3)%mom_tke' ) 4889 IF ( ALLOCATED( surf_v(3)%mom_flux_tke ) .AND. kk == 1 ) & 4890 READ ( 13 ) surf_v(3)%mom_flux_tke 4891 4892 CASE DEFAULT 4893 4894 found = .FALSE. 4895 4896 END SELECT 4897 ! 4898 !-- Redistribute surface elements on its respective type. Start with horizontally orientated surfaces. 4899 IF ( horizontal_surface .AND. & 4900 .NOT. INDEX( restart_string(1:length), '%start_index' ) /= 0 ) & 4901 THEN 4902 4903 ic = nxlc 4904 DO i = nxlf, nxrf 4905 jc = nysc 4906 DO j = nysf, nynf 4907 ! 4908 !-- Determine type of surface element, i.e. default, natural, urban, at current grid point. 4909 surf_match_def = surf_def_h(l)%end_index(jc,ic) >= surf_def_h(l)%start_index(jc,ic) 4910 surf_match_lsm = ( surf_lsm_h%end_index(jc,ic) >= surf_lsm_h%start_index(jc,ic) ) & 4911 .AND. l == 0 4912 surf_match_usm = ( surf_usm_h%end_index(jc,ic) >= surf_usm_h%start_index(jc,ic) ) & 4913 .AND. l == 0 4914 ! 4915 !-- Write restart data onto default-type surfaces if required. 4916 IF ( surf_match_def ) THEN 4917 ! 4918 !-- Set the start index for the local surface element 4919 mm = surf_def_h(l)%start_index(jc,ic) 4920 ! 4921 !-- For index pair (j,i) on file loop from start to end index, and in case the local 4922 !-- surface element mm is smaller than the local end index, assign the respective 4923 !-- surface data to this element. 4924 DO m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i) 4925 IF ( surf_def_h(l)%end_index(jc,ic) >= mm ) & 4926 CALL restore_surface_elements( surf_def_h(l), mm, surf_h(l), m ) 4927 mm = mm + 1 4928 ENDDO 4343 4929 ENDIF 4344 4930 ! 4345 !-- Read the number of vertically orientated surface elements and4346 !-- allocate arrays4347 CASE ( 'ns_v_on_file' ) 4348 IF ( kk == 1 )THEN4349 READ ( 13 ) ns_v_on_file4350 4351 DO l = 0, 34352 IF ( ALLOCATED( surf_v(l)%start_index ) ) &4353 CALL deallocate_surface_attributes_v( surf_v(l) )4931 !-- Same for natural-type surfaces. Please note, it is implicitly assumed that natural 4932 !-- surface elements are below urban surface elements if there are several horizontal 4933 !-- surfaces at (j,i). An example would be bridges. 4934 IF ( surf_match_lsm ) THEN 4935 mm = surf_lsm_h%start_index(jc,ic) 4936 DO m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i) 4937 IF ( surf_lsm_h%end_index(jc,ic) >= mm ) & 4938 CALL restore_surface_elements( surf_lsm_h, mm, surf_h(l), m ) 4939 mm = mm + 1 4354 4940 ENDDO 4355 4356 DO l = 0, 34357 surf_v(l)%ns = ns_v_on_file(l)4358 CALL allocate_surface_attributes_v( surf_v(l), &4359 nys_on_file, nyn_on_file, &4360 nxl_on_file, nxr_on_file )4361 ENDDO4362 4363 4941 ENDIF 4364 4942 ! 4365 !-- Read start and end indices of surface elements at each (ji)-gridpoint 4366 CASE ( 'surf_h(0)%start_index' ) 4367 IF ( kk == 1 ) & 4368 READ ( 13 ) surf_h(0)%start_index 4369 l = 0 4370 CASE ( 'surf_h(0)%end_index' ) 4371 IF ( kk == 1 ) & 4372 READ ( 13 ) surf_h(0)%end_index 4373 horizontal_surface = .TRUE. 4374 vertical_surface = .FALSE. 4375 ! 4376 !-- Read specific attributes 4377 CASE ( 'surf_h(0)%us' ) 4378 IF ( ALLOCATED( surf_h(0)%us ) .AND. kk == 1 ) & 4379 READ ( 13 ) surf_h(0)%us 4380 CASE ( 'surf_h(0)%ts' ) 4381 IF ( ALLOCATED( surf_h(0)%ts ) .AND. kk == 1 ) & 4382 READ ( 13 ) surf_h(0)%ts 4383 CASE ( 'surf_h(0)%qs' ) 4384 IF ( ALLOCATED( surf_h(0)%qs ) .AND. kk == 1 ) & 4385 READ ( 13 ) surf_h(0)%qs 4386 CASE ( 'surf_h(0)%ss' ) 4387 IF ( ALLOCATED( surf_h(0)%ss ) .AND. kk == 1 ) & 4388 READ ( 13 ) surf_h(0)%ss 4389 CASE ( 'surf_h(0)%qcs' ) 4390 IF ( ALLOCATED( surf_h(0)%qcs ) .AND. kk == 1 ) & 4391 READ ( 13 ) surf_h(0)%qcs 4392 CASE ( 'surf_h(0)%ncs' ) 4393 IF ( ALLOCATED( surf_h(0)%ncs ) .AND. kk == 1 ) & 4394 READ ( 13 ) surf_h(0)%ncs 4395 CASE ( 'surf_h(0)%qis' ) 4396 IF ( ALLOCATED( surf_h(0)%qis ) .AND. kk == 1 ) & 4397 READ ( 13 ) surf_h(0)%qis 4398 CASE ( 'surf_h(0)%nis' ) 4399 IF ( ALLOCATED( surf_h(0)%nis ) .AND. kk == 1 ) & 4400 READ ( 13 ) surf_h(0)%nis 4401 CASE ( 'surf_h(0)%qrs' ) 4402 IF ( ALLOCATED( surf_h(0)%qrs ) .AND. kk == 1 ) & 4403 READ ( 13 ) surf_h(0)%qrs 4404 CASE ( 'surf_h(0)%nrs' ) 4405 IF ( ALLOCATED( surf_h(0)%nrs ) .AND. kk == 1 ) & 4406 READ ( 13 ) surf_h(0)%nrs 4407 CASE ( 'surf_h(0)%ol' ) 4408 IF ( ALLOCATED( surf_h(0)%ol ) .AND. kk == 1 ) & 4409 READ ( 13 ) surf_h(0)%ol 4410 CASE ( 'surf_h(0)%rib' ) 4411 IF ( ALLOCATED( surf_h(0)%rib ) .AND. kk == 1 ) & 4412 READ ( 13 ) surf_h(0)%rib 4413 CASE ( 'surf_h(0)%pt_surface' ) 4414 IF ( ALLOCATED( surf_h(0)%pt_surface ) .AND. kk == 1 ) & 4415 READ ( 13 ) surf_h(0)%pt_surface 4416 CASE ( 'surf_h(0)%q_surface' ) 4417 IF ( ALLOCATED( surf_h(0)%q_surface ) .AND. kk == 1 ) & 4418 READ ( 13 ) surf_h(0)%q_surface 4419 CASE ( 'surf_h(0)%vpt_surface' ) 4420 IF ( ALLOCATED( surf_h(0)%vpt_surface ) .AND. kk == 1 ) & 4421 READ ( 13 ) surf_h(0)%vpt_surface 4422 CASE ( 'surf_h(0)%usws' ) 4423 IF ( ALLOCATED( surf_h(0)%usws ) .AND. kk == 1 ) & 4424 READ ( 13 ) surf_h(0)%usws 4425 CASE ( 'surf_h(0)%vsws' ) 4426 IF ( ALLOCATED( surf_h(0)%vsws ) .AND. kk == 1 ) & 4427 READ ( 13 ) surf_h(0)%vsws 4428 CASE ( 'surf_h(0)%shf' ) 4429 IF ( ALLOCATED( surf_h(0)%shf ) .AND. kk == 1 ) & 4430 READ ( 13 ) surf_h(0)%shf 4431 CASE ( 'surf_h(0)%qsws' ) 4432 IF ( ALLOCATED( surf_h(0)%qsws ) .AND. kk == 1 ) & 4433 READ ( 13 ) surf_h(0)%qsws 4434 CASE ( 'surf_h(0)%ssws' ) 4435 IF ( ALLOCATED( surf_h(0)%ssws ) .AND. kk == 1 ) & 4436 READ ( 13 ) surf_h(0)%ssws 4437 CASE ( 'surf_h(0)%css' ) 4438 IF ( ALLOCATED( surf_h(0)%css ) .AND. kk == 1 ) & 4439 READ ( 13 ) surf_h(0)%css 4440 CASE ( 'surf_h(0)%cssws' ) 4441 IF ( ALLOCATED( surf_h(0)%cssws ) .AND. kk == 1 ) & 4442 READ ( 13 ) surf_h(0)%cssws 4443 CASE ( 'surf_h(0)%qcsws' ) 4444 IF ( ALLOCATED( surf_h(0)%qcsws ) .AND. kk == 1 ) & 4445 READ ( 13 ) surf_h(0)%qcsws 4446 CASE ( 'surf_h(0)%ncsws' ) 4447 IF ( ALLOCATED( surf_h(0)%ncsws ) .AND. kk == 1 ) & 4448 READ ( 13 ) surf_h(0)%ncsws 4449 CASE ( 'surf_h(0)%qisws' ) 4450 IF ( ALLOCATED( surf_h(0)%qisws ) .AND. kk == 1 ) & 4451 READ ( 13 ) surf_h(0)%qisws 4452 CASE ( 'surf_h(0)%nisws' ) 4453 IF ( ALLOCATED( surf_h(0)%nisws ) .AND. kk == 1 ) & 4454 READ ( 13 ) surf_h(0)%nisws 4455 CASE ( 'surf_h(0)%qrsws' ) 4456 IF ( ALLOCATED( surf_h(0)%qrsws ) .AND. kk == 1 ) & 4457 READ ( 13 ) surf_h(0)%qrsws 4458 CASE ( 'surf_h(0)%nrsws' ) 4459 IF ( ALLOCATED( surf_h(0)%nrsws ) .AND. kk == 1 ) & 4460 READ ( 13 ) surf_h(0)%nrsws 4461 CASE ( 'surf_h(0)%sasws' ) 4462 IF ( ALLOCATED( surf_h(0)%sasws ) .AND. kk == 1 ) & 4463 READ ( 13 ) surf_h(0)%sasws 4464 4465 CASE ( 'surf_h(1)%start_index' ) 4466 IF ( kk == 1 ) & 4467 READ ( 13 ) surf_h(1)%start_index 4468 l = 1 4469 CASE ( 'surf_h(1)%end_index' ) 4470 IF ( kk == 1 ) & 4471 READ ( 13 ) surf_h(1)%end_index 4472 CASE ( 'surf_h(1)%us' ) 4473 IF ( ALLOCATED( surf_h(1)%us ) .AND. kk == 1 ) & 4474 READ ( 13 ) surf_h(1)%us 4475 CASE ( 'surf_h(1)%ts' ) 4476 IF ( ALLOCATED( surf_h(1)%ts ) .AND. kk == 1 ) & 4477 READ ( 13 ) surf_h(1)%ts 4478 CASE ( 'surf_h(1)%qs' ) 4479 IF ( ALLOCATED( surf_h(1)%qs ) .AND. kk == 1 ) & 4480 READ ( 13 ) surf_h(1)%qs 4481 CASE ( 'surf_h(1)%ss' ) 4482 IF ( ALLOCATED( surf_h(1)%ss ) .AND. kk == 1 ) & 4483 READ ( 13 ) surf_h(1)%ss 4484 CASE ( 'surf_h(1)%qcs' ) 4485 IF ( ALLOCATED( surf_h(1)%qcs ) .AND. kk == 1 ) & 4486 READ ( 13 ) surf_h(1)%qcs 4487 CASE ( 'surf_h(1)%ncs' ) 4488 IF ( ALLOCATED( surf_h(1)%ncs ) .AND. kk == 1 ) & 4489 READ ( 13 ) surf_h(1)%ncs 4490 CASE ( 'surf_h(1)%qis' ) 4491 IF ( ALLOCATED( surf_h(1)%qis ) .AND. kk == 1 ) & 4492 READ ( 13 ) surf_h(1)%qis 4493 CASE ( 'surf_h(1)%nis' ) 4494 IF ( ALLOCATED( surf_h(1)%nis ) .AND. kk == 1 ) & 4495 READ ( 13 ) surf_h(1)%nis 4496 CASE ( 'surf_h(1)%qrs' ) 4497 IF ( ALLOCATED( surf_h(1)%qrs ) .AND. kk == 1 ) & 4498 READ ( 13 ) surf_h(1)%qrs 4499 CASE ( 'surf_h(1)%nrs' ) 4500 IF ( ALLOCATED( surf_h(1)%nrs ) .AND. kk == 1 ) & 4501 READ ( 13 ) surf_h(1)%nrs 4502 CASE ( 'surf_h(1)%ol' ) 4503 IF ( ALLOCATED( surf_h(1)%ol ) .AND. kk == 1 ) & 4504 READ ( 13 ) surf_h(1)%ol 4505 CASE ( 'surf_h(1)%rib' ) 4506 IF ( ALLOCATED( surf_h(1)%rib ) .AND. kk == 1 ) & 4507 READ ( 13 ) surf_h(1)%rib 4508 CASE ( 'surf_h(1)%pt_surface' ) 4509 IF ( ALLOCATED( surf_h(1)%pt_surface ) .AND. kk == 1 ) & 4510 READ ( 13 ) surf_h(1)%pt_surface 4511 CASE ( 'surf_h(1)%q_surface' ) 4512 IF ( ALLOCATED( surf_h(1)%q_surface ) .AND. kk == 1 ) & 4513 READ ( 13 ) surf_h(1)%q_surface 4514 CASE ( 'surf_h(1)%vpt_surface' ) 4515 IF ( ALLOCATED( surf_h(1)%vpt_surface ) .AND. kk == 1 ) & 4516 READ ( 13 ) surf_h(1)%vpt_surface 4517 CASE ( 'surf_h(1)%usws' ) 4518 IF ( ALLOCATED( surf_h(1)%usws ) .AND. kk == 1 ) & 4519 READ ( 13 ) surf_h(1)%usws 4520 CASE ( 'surf_h(1)%vsws' ) 4521 IF ( ALLOCATED( surf_h(1)%vsws ) .AND. kk == 1 ) & 4522 READ ( 13 ) surf_h(1)%vsws 4523 CASE ( 'surf_h(1)%shf' ) 4524 IF ( ALLOCATED( surf_h(1)%shf ) .AND. kk == 1 ) & 4525 READ ( 13 ) surf_h(1)%shf 4526 CASE ( 'surf_h(1)%qsws' ) 4527 IF ( ALLOCATED( surf_h(1)%qsws ) .AND. kk == 1 ) & 4528 READ ( 13 ) surf_h(1)%qsws 4529 CASE ( 'surf_h(1)%ssws' ) 4530 IF ( ALLOCATED( surf_h(1)%ssws ) .AND. kk == 1 ) & 4531 READ ( 13 ) surf_h(1)%ssws 4532 CASE ( 'surf_h(1)%css' ) 4533 IF ( ALLOCATED( surf_h(1)%css ) .AND. kk == 1 ) & 4534 READ ( 13 ) surf_h(1)%css 4535 CASE ( 'surf_h(1)%cssws' ) 4536 IF ( ALLOCATED( surf_h(1)%cssws ) .AND. kk == 1 ) & 4537 READ ( 13 ) surf_h(1)%cssws 4538 CASE ( 'surf_h(1)%qcsws' ) 4539 IF ( ALLOCATED( surf_h(1)%qcsws ) .AND. kk == 1 ) & 4540 READ ( 13 ) surf_h(1)%qcsws 4541 CASE ( 'surf_h(1)%ncsws' ) 4542 IF ( ALLOCATED( surf_h(1)%ncsws ) .AND. kk == 1 ) & 4543 READ ( 13 ) surf_h(1)%ncsws 4544 CASE ( 'surf_h(1)%qisws' ) 4545 IF ( ALLOCATED( surf_h(1)%qisws ) .AND. kk == 1 ) & 4546 READ ( 13 ) surf_h(1)%qisws 4547 CASE ( 'surf_h(1)%nisws' ) 4548 IF ( ALLOCATED( surf_h(1)%nisws ) .AND. kk == 1 ) & 4549 READ ( 13 ) surf_h(1)%nisws 4550 CASE ( 'surf_h(1)%qrsws' ) 4551 IF ( ALLOCATED( surf_h(1)%qrsws ) .AND. kk == 1 ) & 4552 READ ( 13 ) surf_h(1)%qrsws 4553 CASE ( 'surf_h(1)%nrsws' ) 4554 IF ( ALLOCATED( surf_h(1)%nrsws ) .AND. kk == 1 ) & 4555 READ ( 13 ) surf_h(1)%nrsws 4556 CASE ( 'surf_h(1)%sasws' ) 4557 IF ( ALLOCATED( surf_h(1)%sasws ) .AND. kk == 1 ) & 4558 READ ( 13 ) surf_h(1)%sasws 4559 4560 CASE ( 'surf_h(2)%start_index' ) 4561 IF ( kk == 1 ) & 4562 READ ( 13 ) surf_h(2)%start_index 4563 l = 2 4564 CASE ( 'surf_h(2)%end_index' ) 4565 IF ( kk == 1 ) & 4566 READ ( 13 ) surf_h(2)%end_index 4567 CASE ( 'surf_h(2)%us' ) 4568 IF ( ALLOCATED( surf_h(2)%us ) .AND. kk == 1 ) & 4569 READ ( 13 ) surf_h(2)%us 4570 CASE ( 'surf_h(2)%ts' ) 4571 IF ( ALLOCATED( surf_h(2)%ts ) .AND. kk == 1 ) & 4572 READ ( 13 ) surf_h(2)%ts 4573 CASE ( 'surf_h(2)%qs' ) 4574 IF ( ALLOCATED( surf_h(2)%qs ) .AND. kk == 1 ) & 4575 READ ( 13 ) surf_h(2)%qs 4576 CASE ( 'surf_h(2)%ss' ) 4577 IF ( ALLOCATED( surf_h(2)%ss ) .AND. kk == 1 ) & 4578 READ ( 13 ) surf_h(2)%ss 4579 CASE ( 'surf_h(2)%qcs' ) 4580 IF ( ALLOCATED( surf_h(2)%qcs ) .AND. kk == 1 ) & 4581 READ ( 13 ) surf_h(2)%qcs 4582 CASE ( 'surf_h(2)%ncs' ) 4583 IF ( ALLOCATED( surf_h(2)%ncs ) .AND. kk == 1 ) & 4584 READ ( 13 ) surf_h(2)%ncs 4585 CASE ( 'surf_h(2)%qis' ) 4586 IF ( ALLOCATED( surf_h(2)%qis ) .AND. kk == 1 ) & 4587 READ ( 13 ) surf_h(2)%qis 4588 CASE ( 'surf_h(2)%nis' ) 4589 IF ( ALLOCATED( surf_h(2)%nis ) .AND. kk == 1 ) & 4590 READ ( 13 ) surf_h(2)%nis 4591 CASE ( 'surf_h(2)%qrs' ) 4592 IF ( ALLOCATED( surf_h(2)%qrs ) .AND. kk == 1 ) & 4593 READ ( 13 ) surf_h(2)%qrs 4594 CASE ( 'surf_h(2)%nrs' ) 4595 IF ( ALLOCATED( surf_h(2)%nrs ) .AND. kk == 1 ) & 4596 READ ( 13 ) surf_h(2)%nrs 4597 CASE ( 'surf_h(2)%ol' ) 4598 IF ( ALLOCATED( surf_h(2)%ol ) .AND. kk == 1 ) & 4599 READ ( 13 ) surf_h(2)%ol 4600 CASE ( 'surf_h(2)%rib' ) 4601 IF ( ALLOCATED( surf_h(2)%rib ) .AND. kk == 1 ) & 4602 READ ( 13 ) surf_h(2)%rib 4603 CASE ( 'surf_h(2)%pt_surface' ) 4604 IF ( ALLOCATED( surf_h(2)%pt_surface ) .AND. kk == 1 ) & 4605 READ ( 13 ) surf_h(2)%pt_surface 4606 CASE ( 'surf_h(2)%q_surface' ) 4607 IF ( ALLOCATED( surf_h(2)%q_surface ) .AND. kk == 1 ) & 4608 READ ( 13 ) surf_h(2)%q_surface 4609 CASE ( 'surf_h(2)%vpt_surface' ) 4610 IF ( ALLOCATED( surf_h(2)%vpt_surface ) .AND. kk == 1 ) & 4611 READ ( 13 ) surf_h(2)%vpt_surface 4612 CASE ( 'surf_h(2)%usws' ) 4613 IF ( ALLOCATED( surf_h(2)%usws ) .AND. kk == 1 ) & 4614 READ ( 13 ) surf_h(2)%usws 4615 CASE ( 'surf_h(2)%vsws' ) 4616 IF ( ALLOCATED( surf_h(2)%vsws ) .AND. kk == 1 ) & 4617 READ ( 13 ) surf_h(2)%vsws 4618 CASE ( 'surf_h(2)%shf' ) 4619 IF ( ALLOCATED( surf_h(2)%shf ) .AND. kk == 1 ) & 4620 READ ( 13 ) surf_h(2)%shf 4621 CASE ( 'surf_h(2)%qsws' ) 4622 IF ( ALLOCATED( surf_h(2)%qsws ) .AND. kk == 1 ) & 4623 READ ( 13 ) surf_h(2)%qsws 4624 CASE ( 'surf_h(2)%ssws' ) 4625 IF ( ALLOCATED( surf_h(2)%ssws ) .AND. kk == 1 ) & 4626 READ ( 13 ) surf_h(2)%ssws 4627 CASE ( 'surf_h(2)%css' ) 4628 IF ( ALLOCATED( surf_h(2)%css ) .AND. kk == 1 ) & 4629 READ ( 13 ) surf_h(2)%css 4630 CASE ( 'surf_h(2)%cssws' ) 4631 IF ( ALLOCATED( surf_h(2)%cssws ) .AND. kk == 1 ) & 4632 READ ( 13 ) surf_h(2)%cssws 4633 CASE ( 'surf_h(2)%qcsws' ) 4634 IF ( ALLOCATED( surf_h(2)%qcsws ) .AND. kk == 1 ) & 4635 READ ( 13 ) surf_h(2)%qcsws 4636 CASE ( 'surf_h(2)%ncsws' ) 4637 IF ( ALLOCATED( surf_h(2)%ncsws ) .AND. kk == 1 ) & 4638 READ ( 13 ) surf_h(2)%ncsws 4639 CASE ( 'surf_h(2)%qisws' ) 4640 IF ( ALLOCATED( surf_h(2)%qisws ) .AND. kk == 1 ) & 4641 READ ( 13 ) surf_h(2)%qisws 4642 CASE ( 'surf_h(2)%nisws' ) 4643 IF ( ALLOCATED( surf_h(2)%nisws ) .AND. kk == 1 ) & 4644 READ ( 13 ) surf_h(2)%nisws 4645 CASE ( 'surf_h(2)%qrsws' ) 4646 IF ( ALLOCATED( surf_h(2)%qrsws ) .AND. kk == 1 ) & 4647 READ ( 13 ) surf_h(2)%qrsws 4648 CASE ( 'surf_h(2)%nrsws' ) 4649 IF ( ALLOCATED( surf_h(2)%nrsws ) .AND. kk == 1 ) & 4650 READ ( 13 ) surf_h(2)%nrsws 4651 CASE ( 'surf_h(2)%sasws' ) 4652 IF ( ALLOCATED( surf_h(2)%sasws ) .AND. kk == 1 ) & 4653 READ ( 13 ) surf_h(2)%sasws 4654 4655 CASE ( 'surf_v(0)%start_index' ) 4656 IF ( kk == 1 ) & 4657 READ ( 13 ) surf_v(0)%start_index 4658 l = 0 4659 horizontal_surface = .FALSE. 4660 vertical_surface = .TRUE. 4661 CASE ( 'surf_v(0)%end_index' ) 4662 IF ( kk == 1 ) & 4663 READ ( 13 ) surf_v(0)%end_index 4664 CASE ( 'surf_v(0)%us' ) 4665 IF ( ALLOCATED( surf_v(0)%us ) .AND. kk == 1 ) & 4666 READ ( 13 ) surf_v(0)%us 4667 CASE ( 'surf_v(0)%ts' ) 4668 IF ( ALLOCATED( surf_v(0)%ts ) .AND. kk == 1 ) & 4669 READ ( 13 ) surf_v(0)%ts 4670 CASE ( 'surf_v(0)%qs' ) 4671 IF ( ALLOCATED( surf_v(0)%qs ) .AND. kk == 1 ) & 4672 READ ( 13 ) surf_v(0)%qs 4673 CASE ( 'surf_v(0)%ss' ) 4674 IF ( ALLOCATED( surf_v(0)%ss ) .AND. kk == 1 ) & 4675 READ ( 13 ) surf_v(0)%ss 4676 CASE ( 'surf_v(0)%qcs' ) 4677 IF ( ALLOCATED( surf_v(0)%qcs ) .AND. kk == 1 ) & 4678 READ ( 13 ) surf_v(0)%qcs 4679 CASE ( 'surf_v(0)%ncs' ) 4680 IF ( ALLOCATED( surf_v(0)%ncs ) .AND. kk == 1 ) & 4681 READ ( 13 ) surf_v(0)%ncs 4682 CASE ( 'surf_v(0)%qis' ) 4683 IF ( ALLOCATED( surf_v(0)%qis ) .AND. kk == 1 ) & 4684 READ ( 13 ) surf_v(0)%qis 4685 CASE ( 'surf_v(0)%nis' ) 4686 IF ( ALLOCATED( surf_v(0)%nis ) .AND. kk == 1 ) & 4687 READ ( 13 ) surf_v(0)%nis 4688 CASE ( 'surf_v(0)%qrs' ) 4689 IF ( ALLOCATED( surf_v(0)%qrs ) .AND. kk == 1 ) & 4690 READ ( 13 ) surf_v(0)%qrs 4691 CASE ( 'surf_v(0)%nrs' ) 4692 IF ( ALLOCATED( surf_v(0)%nrs ) .AND. kk == 1 ) & 4693 READ ( 13 ) surf_v(0)%nrs 4694 CASE ( 'surf_v(0)%ol' ) 4695 IF ( ALLOCATED( surf_v(0)%ol ) .AND. kk == 1 ) & 4696 READ ( 13 ) surf_v(0)%ol 4697 CASE ( 'surf_v(0)%rib' ) 4698 IF ( ALLOCATED( surf_v(0)%rib ) .AND. kk == 1 ) & 4699 READ ( 13 ) surf_v(0)%rib 4700 CASE ( 'surf_v(0)%pt_surface' ) 4701 IF ( ALLOCATED( surf_v(0)%pt_surface ) .AND. kk == 1 ) & 4702 READ ( 13 ) surf_v(0)%pt_surface 4703 CASE ( 'surf_v(0)%q_surface' ) 4704 IF ( ALLOCATED( surf_v(0)%q_surface ) .AND. kk == 1 ) & 4705 READ ( 13 ) surf_v(0)%q_surface 4706 CASE ( 'surf_v(0)%vpt_surface' ) 4707 IF ( ALLOCATED( surf_v(0)%vpt_surface ) .AND. kk == 1 ) & 4708 READ ( 13 ) surf_v(0)%vpt_surface 4709 CASE ( 'surf_v(0)%shf' ) 4710 IF ( ALLOCATED( surf_v(0)%shf ) .AND. kk == 1 ) & 4711 READ ( 13 ) surf_v(0)%shf 4712 CASE ( 'surf_v(0)%qsws' ) 4713 IF ( ALLOCATED( surf_v(0)%qsws ) .AND. kk == 1 ) & 4714 READ ( 13 ) surf_v(0)%qsws 4715 CASE ( 'surf_v(0)%ssws' ) 4716 IF ( ALLOCATED( surf_v(0)%ssws ) .AND. kk == 1 ) & 4717 READ ( 13 ) surf_v(0)%ssws 4718 CASE ( 'surf_v(0)%css' ) 4719 IF ( ALLOCATED( surf_v(0)%css ) .AND. kk == 1 ) & 4720 READ ( 13 ) surf_v(0)%css 4721 CASE ( 'surf_v(0)%cssws' ) 4722 IF ( ALLOCATED( surf_v(0)%cssws ) .AND. kk == 1 ) & 4723 READ ( 13 ) surf_v(0)%cssws 4724 CASE ( 'surf_v(0)%qcsws' ) 4725 IF ( ALLOCATED( surf_v(0)%qcsws ) .AND. kk == 1 ) & 4726 READ ( 13 ) surf_v(0)%qcsws 4727 CASE ( 'surf_v(0)%ncsws' ) 4728 IF ( ALLOCATED( surf_v(0)%ncsws ) .AND. kk == 1 ) & 4729 READ ( 13 ) surf_v(0)%ncsws 4730 CASE ( 'surf_v(0)%qisws' ) 4731 IF ( ALLOCATED( surf_v(0)%qisws ) .AND. kk == 1 ) & 4732 READ ( 13 ) surf_v(0)%qisws 4733 CASE ( 'surf_v(0)%nisws' ) 4734 IF ( ALLOCATED( surf_v(0)%nisws ) .AND. kk == 1 ) & 4735 READ ( 13 ) surf_v(0)%nisws 4736 CASE ( 'surf_v(0)%qrsws' ) 4737 IF ( ALLOCATED( surf_v(0)%qrsws ) .AND. kk == 1 ) & 4738 READ ( 13 ) surf_v(0)%qrsws 4739 CASE ( 'surf_v(0)%nrsws' ) 4740 IF ( ALLOCATED( surf_v(0)%nrsws ) .AND. kk == 1 ) & 4741 READ ( 13 ) surf_v(0)%nrsws 4742 CASE ( 'surf_v(0)%sasws' ) 4743 IF ( ALLOCATED( surf_v(0)%sasws ) .AND. kk == 1 ) & 4744 READ ( 13 ) surf_v(0)%sasws 4745 CASE ( 'surf_v(0)%mom_uv' ) 4746 IF ( ALLOCATED( surf_v(0)%mom_flux_uv ) .AND. kk == 1 ) & 4747 READ ( 13 ) surf_v(0)%mom_flux_uv 4748 CASE ( 'surf_v(0)%mom_w' ) 4749 IF ( ALLOCATED( surf_v(0)%mom_flux_w ) .AND. kk == 1 ) & 4750 READ ( 13 ) surf_v(0)%mom_flux_w 4751 CASE ( 'surf_v(0)%mom_tke' ) 4752 IF ( ALLOCATED( surf_v(0)%mom_flux_tke ) .AND. kk == 1 ) & 4753 READ ( 13 ) surf_v(0)%mom_flux_tke 4754 4755 CASE ( 'surf_v(1)%start_index' ) 4756 IF ( kk == 1 ) & 4757 READ ( 13 ) surf_v(1)%start_index 4758 l = 1 4759 CASE ( 'surf_v(1)%end_index' ) 4760 IF ( kk == 1 ) & 4761 READ ( 13 ) surf_v(1)%end_index 4762 CASE ( 'surf_v(1)%us' ) 4763 IF ( ALLOCATED( surf_v(1)%us ) .AND. kk == 1 ) & 4764 READ ( 13 ) surf_v(1)%us 4765 CASE ( 'surf_v(1)%ts' ) 4766 IF ( ALLOCATED( surf_v(1)%ts ) .AND. kk == 1 ) & 4767 READ ( 13 ) surf_v(1)%ts 4768 CASE ( 'surf_v(1)%qs' ) 4769 IF ( ALLOCATED( surf_v(1)%qs ) .AND. kk == 1 ) & 4770 READ ( 13 ) surf_v(1)%qs 4771 CASE ( 'surf_v(1)%ss' ) 4772 IF ( ALLOCATED( surf_v(1)%ss ) .AND. kk == 1 ) & 4773 READ ( 13 ) surf_v(1)%ss 4774 CASE ( 'surf_v(1)%qcs' ) 4775 IF ( ALLOCATED( surf_v(1)%qcs ) .AND. kk == 1 ) & 4776 READ ( 13 ) surf_v(1)%qcs 4777 CASE ( 'surf_v(1)%ncs' ) 4778 IF ( ALLOCATED( surf_v(1)%ncs ) .AND. kk == 1 ) & 4779 READ ( 13 ) surf_v(1)%ncs 4780 CASE ( 'surf_v(1)%qis' ) 4781 IF ( ALLOCATED( surf_v(1)%qis ) .AND. kk == 1 ) & 4782 READ ( 13 ) surf_v(1)%qis 4783 CASE ( 'surf_v(1)%nis' ) 4784 IF ( ALLOCATED( surf_v(1)%nis ) .AND. kk == 1 ) & 4785 READ ( 13 ) surf_v(1)%nis 4786 CASE ( 'surf_v(1)%qrs' ) 4787 IF ( ALLOCATED( surf_v(1)%qrs ) .AND. kk == 1 ) & 4788 READ ( 13 ) surf_v(1)%qrs 4789 CASE ( 'surf_v(1)%nrs' ) 4790 IF ( ALLOCATED( surf_v(1)%nrs ) .AND. kk == 1 ) & 4791 READ ( 13 ) surf_v(1)%nrs 4792 CASE ( 'surf_v(1)%ol' ) 4793 IF ( ALLOCATED( surf_v(1)%ol ) .AND. kk == 1 ) & 4794 READ ( 13 ) surf_v(1)%ol 4795 CASE ( 'surf_v(1)%rib' ) 4796 IF ( ALLOCATED( surf_v(1)%rib ) .AND. kk == 1 ) & 4797 READ ( 13 ) surf_v(1)%rib 4798 CASE ( 'surf_v(1)%pt_surface' ) 4799 IF ( ALLOCATED( surf_v(1)%pt_surface ) .AND. kk == 1 ) & 4800 READ ( 13 ) surf_v(1)%pt_surface 4801 CASE ( 'surf_v(1)%q_surface' ) 4802 IF ( ALLOCATED( surf_v(1)%q_surface ) .AND. kk == 1 ) & 4803 READ ( 13 ) surf_v(1)%q_surface 4804 CASE ( 'surf_v(1)%vpt_surface' ) 4805 IF ( ALLOCATED( surf_v(1)%vpt_surface ) .AND. kk == 1 ) & 4806 READ ( 13 ) surf_v(1)%vpt_surface 4807 CASE ( 'surf_v(1)%shf' ) 4808 IF ( ALLOCATED( surf_v(1)%shf ) .AND. kk == 1 ) & 4809 READ ( 13 ) surf_v(1)%shf 4810 CASE ( 'surf_v(1)%qsws' ) 4811 IF ( ALLOCATED( surf_v(1)%qsws ) .AND. kk == 1 ) & 4812 READ ( 13 ) surf_v(1)%qsws 4813 CASE ( 'surf_v(1)%ssws' ) 4814 IF ( ALLOCATED( surf_v(1)%ssws ) .AND. kk == 1 ) & 4815 READ ( 13 ) surf_v(1)%ssws 4816 CASE ( 'surf_v(1)%css' ) 4817 IF ( ALLOCATED( surf_v(1)%css ) .AND. kk == 1 ) & 4818 READ ( 13 ) surf_v(1)%css 4819 CASE ( 'surf_v(1)%cssws' ) 4820 IF ( ALLOCATED( surf_v(1)%cssws ) .AND. kk == 1 ) & 4821 READ ( 13 ) surf_v(1)%cssws 4822 CASE ( 'surf_v(1)%qcsws' ) 4823 IF ( ALLOCATED( surf_v(1)%qcsws ) .AND. kk == 1 ) & 4824 READ ( 13 ) surf_v(1)%qcsws 4825 CASE ( 'surf_v(1)%ncsws' ) 4826 IF ( ALLOCATED( surf_v(1)%ncsws ) .AND. kk == 1 ) & 4827 READ ( 13 ) surf_v(1)%ncsws 4828 CASE ( 'surf_v(1)%qisws' ) 4829 IF ( ALLOCATED( surf_v(1)%qisws ) .AND. kk == 1 ) & 4830 READ ( 13 ) surf_v(1)%qisws 4831 CASE ( 'surf_v(1)%nisws' ) 4832 IF ( ALLOCATED( surf_v(1)%nisws ) .AND. kk == 1 ) & 4833 READ ( 13 ) surf_v(1)%nisws 4834 CASE ( 'surf_v(1)%qrsws' ) 4835 IF ( ALLOCATED( surf_v(1)%qrsws ) .AND. kk == 1 ) & 4836 READ ( 13 ) surf_v(1)%qrsws 4837 CASE ( 'surf_v(1)%nrsws' ) 4838 IF ( ALLOCATED( surf_v(1)%nrsws ) .AND. kk == 1 ) & 4839 READ ( 13 ) surf_v(1)%nrsws 4840 CASE ( 'surf_v(1)%sasws' ) 4841 IF ( ALLOCATED( surf_v(1)%sasws ) .AND. kk == 1 ) & 4842 READ ( 13 ) surf_v(1)%sasws 4843 CASE ( 'surf_v(1)%mom_uv' ) 4844 IF ( ALLOCATED( surf_v(1)%mom_flux_uv ) .AND. kk == 1 ) & 4845 READ ( 13 ) surf_v(1)%mom_flux_uv 4846 CASE ( 'surf_v(1)%mom_w' ) 4847 IF ( ALLOCATED( surf_v(1)%mom_flux_w ) .AND. kk == 1 ) & 4848 READ ( 13 ) surf_v(1)%mom_flux_w 4849 CASE ( 'surf_v(1)%mom_tke' ) 4850 IF ( ALLOCATED( surf_v(1)%mom_flux_tke ) .AND. kk == 1 ) & 4851 READ ( 13 ) surf_v(1)%mom_flux_tke 4852 4853 CASE ( 'surf_v(2)%start_index' ) 4854 IF ( kk == 1 ) & 4855 READ ( 13 ) surf_v(2)%start_index 4856 l = 2 4857 CASE ( 'surf_v(2)%end_index' ) 4858 IF ( kk == 1 ) & 4859 READ ( 13 ) surf_v(2)%end_index 4860 CASE ( 'surf_v(2)%us' ) 4861 IF ( ALLOCATED( surf_v(2)%us ) .AND. kk == 1 ) & 4862 READ ( 13 ) surf_v(2)%us 4863 CASE ( 'surf_v(2)%ts' ) 4864 IF ( ALLOCATED( surf_v(2)%ts ) .AND. kk == 1 ) & 4865 READ ( 13 ) surf_v(2)%ts 4866 CASE ( 'surf_v(2)%qs' ) 4867 IF ( ALLOCATED( surf_v(2)%qs ) .AND. kk == 1 ) & 4868 READ ( 13 ) surf_v(2)%qs 4869 CASE ( 'surf_v(2)%ss' ) 4870 IF ( ALLOCATED( surf_v(2)%ss ) .AND. kk == 1 ) & 4871 READ ( 13 ) surf_v(2)%ss 4872 CASE ( 'surf_v(2)%qcs' ) 4873 IF ( ALLOCATED( surf_v(2)%qcs ) .AND. kk == 1 ) & 4874 READ ( 13 ) surf_v(2)%qcs 4875 CASE ( 'surf_v(2)%ncs' ) 4876 IF ( ALLOCATED( surf_v(2)%ncs ) .AND. kk == 1 ) & 4877 READ ( 13 ) surf_v(2)%ncs 4878 CASE ( 'surf_v(2)%qis' ) 4879 IF ( ALLOCATED( surf_v(2)%qis ) .AND. kk == 1 ) & 4880 READ ( 13 ) surf_v(2)%qis 4881 CASE ( 'surf_v(2)%nis' ) 4882 IF ( ALLOCATED( surf_v(2)%nis ) .AND. kk == 1 ) & 4883 READ ( 13 ) surf_v(2)%nis 4884 CASE ( 'surf_v(2)%qrs' ) 4885 IF ( ALLOCATED( surf_v(2)%qrs ) .AND. kk == 1 ) & 4886 READ ( 13 ) surf_v(2)%qrs 4887 CASE ( 'surf_v(2)%nrs' ) 4888 IF ( ALLOCATED( surf_v(2)%nrs ) .AND. kk == 1 ) & 4889 READ ( 13 ) surf_v(2)%nrs 4890 CASE ( 'surf_v(2)%ol' ) 4891 IF ( ALLOCATED( surf_v(2)%ol ) .AND. kk == 1 ) & 4892 READ ( 13 ) surf_v(2)%ol 4893 CASE ( 'surf_v(2)%rib' ) 4894 IF ( ALLOCATED( surf_v(2)%rib ) .AND. kk == 1 ) & 4895 READ ( 13 ) surf_v(2)%rib 4896 CASE ( 'surf_v(2)%pt_surface' ) 4897 IF ( ALLOCATED( surf_v(2)%pt_surface ) .AND. kk == 1 ) & 4898 READ ( 13 ) surf_v(2)%pt_surface 4899 CASE ( 'surf_v(2)%q_surface' ) 4900 IF ( ALLOCATED( surf_v(2)%q_surface ) .AND. kk == 1 ) & 4901 READ ( 13 ) surf_v(2)%q_surface 4902 CASE ( 'surf_v(2)%vpt_surface' ) 4903 IF ( ALLOCATED( surf_v(2)%vpt_surface ) .AND. kk == 1 ) & 4904 READ ( 13 ) surf_v(2)%vpt_surface 4905 CASE ( 'surf_v(2)%shf' ) 4906 IF ( ALLOCATED( surf_v(2)%shf ) .AND. kk == 1 ) & 4907 READ ( 13 ) surf_v(2)%shf 4908 CASE ( 'surf_v(2)%qsws' ) 4909 IF ( ALLOCATED( surf_v(2)%qsws ) .AND. kk == 1 ) & 4910 READ ( 13 ) surf_v(2)%qsws 4911 CASE ( 'surf_v(2)%ssws' ) 4912 IF ( ALLOCATED( surf_v(2)%ssws ) .AND. kk == 1 ) & 4913 READ ( 13 ) surf_v(2)%ssws 4914 CASE ( 'surf_v(2)%css' ) 4915 IF ( ALLOCATED( surf_v(2)%css ) .AND. kk == 1 ) & 4916 READ ( 13 ) surf_v(2)%css 4917 CASE ( 'surf_v(2)%cssws' ) 4918 IF ( ALLOCATED( surf_v(2)%cssws ) .AND. kk == 1 ) & 4919 READ ( 13 ) surf_v(2)%cssws 4920 CASE ( 'surf_v(2)%qcsws' ) 4921 IF ( ALLOCATED( surf_v(2)%qcsws ) .AND. kk == 1 ) & 4922 READ ( 13 ) surf_v(2)%qcsws 4923 CASE ( 'surf_v(2)%ncsws' ) 4924 IF ( ALLOCATED( surf_v(2)%ncsws ) .AND. kk == 1 ) & 4925 READ ( 13 ) surf_v(2)%ncsws 4926 CASE ( 'surf_v(2)%qisws' ) 4927 IF ( ALLOCATED( surf_v(2)%qisws ) .AND. kk == 1 ) & 4928 READ ( 13 ) surf_v(2)%qisws 4929 CASE ( 'surf_v(2)%nisws' ) 4930 IF ( ALLOCATED( surf_v(2)%nisws ) .AND. kk == 1 ) & 4931 READ ( 13 ) surf_v(2)%nisws 4932 CASE ( 'surf_v(2)%qrsws' ) 4933 IF ( ALLOCATED( surf_v(2)%qrsws ) .AND. kk == 1 ) & 4934 READ ( 13 ) surf_v(2)%qrsws 4935 CASE ( 'surf_v(2)%nrsws' ) 4936 IF ( ALLOCATED( surf_v(2)%nrsws ) .AND. kk == 1 ) & 4937 READ ( 13 ) surf_v(2)%nrsws 4938 CASE ( 'surf_v(2)%sasws' ) 4939 IF ( ALLOCATED( surf_v(2)%sasws ) .AND. kk == 1 ) & 4940 READ ( 13 ) surf_v(2)%sasws 4941 CASE ( 'surf_v(2)%mom_uv' ) 4942 IF ( ALLOCATED( surf_v(2)%mom_flux_uv ) .AND. kk == 1 ) & 4943 READ ( 13 ) surf_v(2)%mom_flux_uv 4944 CASE ( 'surf_v(2)%mom_w' ) 4945 IF ( ALLOCATED( surf_v(2)%mom_flux_w ) .AND. kk == 1 ) & 4946 READ ( 13 ) surf_v(2)%mom_flux_w 4947 CASE ( 'surf_v(2)%mom_tke' ) 4948 IF ( ALLOCATED( surf_v(2)%mom_flux_tke ) .AND. kk == 1 ) & 4949 READ ( 13 ) surf_v(2)%mom_flux_tke 4950 4951 CASE ( 'surf_v(3)%start_index' ) 4952 IF ( kk == 1 ) & 4953 READ ( 13 ) surf_v(3)%start_index 4954 l = 3 4955 CASE ( 'surf_v(3)%end_index' ) 4956 IF ( kk == 1 ) & 4957 READ ( 13 ) surf_v(3)%end_index 4958 CASE ( 'surf_v(3)%us' ) 4959 IF ( ALLOCATED( surf_v(3)%us ) .AND. kk == 1 ) & 4960 READ ( 13 ) surf_v(3)%us 4961 CASE ( 'surf_v(3)%ts' ) 4962 IF ( ALLOCATED( surf_v(3)%ts ) .AND. kk == 1 ) & 4963 READ ( 13 ) surf_v(3)%ts 4964 CASE ( 'surf_v(3)%qs' ) 4965 IF ( ALLOCATED( surf_v(3)%qs ) .AND. kk == 1 ) & 4966 READ ( 13 ) surf_v(3)%qs 4967 CASE ( 'surf_v(3)%ss' ) 4968 IF ( ALLOCATED( surf_v(3)%ss ) .AND. kk == 1 ) & 4969 READ ( 13 ) surf_v(3)%ss 4970 CASE ( 'surf_v(3)%qcs' ) 4971 IF ( ALLOCATED( surf_v(3)%qcs ) .AND. kk == 1 ) & 4972 READ ( 13 ) surf_v(3)%qcs 4973 CASE ( 'surf_v(3)%ncs' ) 4974 IF ( ALLOCATED( surf_v(3)%ncs ) .AND. kk == 1 ) & 4975 READ ( 13 ) surf_v(3)%ncs 4976 CASE ( 'surf_v(3)%qis' ) 4977 IF ( ALLOCATED( surf_v(3)%qis ) .AND. kk == 1 ) & 4978 READ ( 13 ) surf_v(3)%qis 4979 CASE ( 'surf_v(3)%nis' ) 4980 IF ( ALLOCATED( surf_v(3)%nis ) .AND. kk == 1 ) & 4981 READ ( 13 ) surf_v(3)%nis 4982 CASE ( 'surf_v(3)%qrs' ) 4983 IF ( ALLOCATED( surf_v(3)%qrs ) .AND. kk == 1 ) & 4984 READ ( 13 ) surf_v(3)%qrs 4985 CASE ( 'surf_v(3)%nrs' ) 4986 IF ( ALLOCATED( surf_v(3)%nrs ) .AND. kk == 1 ) & 4987 READ ( 13 ) surf_v(3)%nrs 4988 CASE ( 'surf_v(3)%ol' ) 4989 IF ( ALLOCATED( surf_v(3)%ol ) .AND. kk == 1 ) & 4990 READ ( 13 ) surf_v(3)%ol 4991 CASE ( 'surf_v(3)%rib' ) 4992 IF ( ALLOCATED( surf_v(3)%rib ) .AND. kk == 1 ) & 4993 READ ( 13 ) surf_v(3)%rib 4994 CASE ( 'surf_v(3)%pt_surface' ) 4995 IF ( ALLOCATED( surf_v(3)%pt_surface ) .AND. kk == 1 ) & 4996 READ ( 13 ) surf_v(3)%pt_surface 4997 CASE ( 'surf_v(3)%q_surface' ) 4998 IF ( ALLOCATED( surf_v(3)%q_surface ) .AND. kk == 1 ) & 4999 READ ( 13 ) surf_v(3)%q_surface 5000 CASE ( 'surf_v(3)%vpt_surface' ) 5001 IF ( ALLOCATED( surf_v(3)%vpt_surface ) .AND. kk == 1 ) & 5002 READ ( 13 ) surf_v(3)%vpt_surface 5003 CASE ( 'surf_v(3)%shf' ) 5004 IF ( ALLOCATED( surf_v(3)%shf ) .AND. kk == 1 ) & 5005 READ ( 13 ) surf_v(3)%shf 5006 CASE ( 'surf_v(3)%qsws' ) 5007 IF ( ALLOCATED( surf_v(3)%qsws ) .AND. kk == 1 ) & 5008 READ ( 13 ) surf_v(3)%qsws 5009 CASE ( 'surf_v(3)%ssws' ) 5010 IF ( ALLOCATED( surf_v(3)%ssws ) .AND. kk == 1 ) & 5011 READ ( 13 ) surf_v(3)%ssws 5012 CASE ( 'surf_v(3)%css' ) 5013 IF ( ALLOCATED( surf_v(3)%css ) .AND. kk == 1 ) & 5014 READ ( 13 ) surf_v(3)%css 5015 CASE ( 'surf_v(3)%cssws' ) 5016 IF ( ALLOCATED( surf_v(3)%cssws ) .AND. kk == 1 ) & 5017 READ ( 13 ) surf_v(3)%cssws 5018 CASE ( 'surf_v(3)%qcsws' ) 5019 IF ( ALLOCATED( surf_v(3)%qcsws ) .AND. kk == 1 ) & 5020 READ ( 13 ) surf_v(3)%qcsws 5021 CASE ( 'surf_v(3)%ncsws' ) 5022 IF ( ALLOCATED( surf_v(3)%ncsws ) .AND. kk == 1 ) & 5023 READ ( 13 ) surf_v(3)%ncsws 5024 CASE ( 'surf_v(3)%qisws' ) 5025 IF ( ALLOCATED( surf_v(3)%qisws ) .AND. kk == 1 ) & 5026 READ ( 13 ) surf_v(3)%qisws 5027 CASE ( 'surf_v(3)%nisws' ) 5028 IF ( ALLOCATED( surf_v(3)%nisws ) .AND. kk == 1 ) & 5029 READ ( 13 ) surf_v(3)%nisws 5030 CASE ( 'surf_v(3)%qrsws' ) 5031 IF ( ALLOCATED( surf_v(3)%qrsws ) .AND. kk == 1 ) & 5032 READ ( 13 ) surf_v(3)%qrsws 5033 CASE ( 'surf_v(3)%nrsws' ) 5034 IF ( ALLOCATED( surf_v(3)%nrsws ) .AND. kk == 1 ) & 5035 READ ( 13 ) surf_v(3)%nrsws 5036 CASE ( 'surf_v(3)%sasws' ) 5037 IF ( ALLOCATED( surf_v(3)%sasws ) .AND. kk == 1 ) & 5038 READ ( 13 ) surf_v(3)%sasws 5039 CASE ( 'surf_v(3)%mom_uv' ) 5040 IF ( ALLOCATED( surf_v(3)%mom_flux_uv ) .AND. kk == 1 ) & 5041 READ ( 13 ) surf_v(3)%mom_flux_uv 5042 CASE ( 'surf_v(3)%mom_w' ) 5043 IF ( ALLOCATED( surf_v(3)%mom_flux_w ) .AND. kk == 1 ) & 5044 READ ( 13 ) surf_v(3)%mom_flux_w 5045 CASE ( 'surf_v(3)%mom_tke' ) 5046 IF ( ALLOCATED( surf_v(3)%mom_flux_tke ) .AND. kk == 1 ) & 5047 READ ( 13 ) surf_v(3)%mom_flux_tke 5048 5049 CASE DEFAULT 5050 5051 found = .FALSE. 5052 5053 END SELECT 5054 ! 5055 !-- Redistribute surface elements on its respective type. Start with 5056 !-- horizontally orientated surfaces. 5057 IF ( horizontal_surface .AND. & 5058 .NOT. INDEX( restart_string(1:length), '%start_index' ) /= 0 ) & 5059 THEN 5060 5061 ic = nxlc 5062 DO i = nxlf, nxrf 5063 jc = nysc 5064 DO j = nysf, nynf 5065 ! 5066 !-- Determine type of surface element, i.e. default, natural, 5067 !-- urban, at current grid point. 5068 surf_match_def = surf_def_h(l)%end_index(jc,ic) >= & 5069 surf_def_h(l)%start_index(jc,ic) 5070 surf_match_lsm = ( surf_lsm_h%end_index(jc,ic) >= & 5071 surf_lsm_h%start_index(jc,ic) ) & 5072 .AND. l == 0 5073 surf_match_usm = ( surf_usm_h%end_index(jc,ic) >= & 5074 surf_usm_h%start_index(jc,ic) ) & 5075 .AND. l == 0 5076 ! 5077 !-- Write restart data onto default-type surfaces if required. 5078 IF ( surf_match_def ) THEN 5079 ! 5080 !-- Set the start index for the local surface element 5081 mm = surf_def_h(l)%start_index(jc,ic) 5082 ! 5083 !-- For index pair (j,i) on file loop from start to end index, 5084 !-- and in case the local surface element mm is smaller than 5085 !-- the local end index, assign the respective surface data 5086 !-- to this element. 5087 DO m = surf_h(l)%start_index(j,i), & 5088 surf_h(l)%end_index(j,i) 5089 IF ( surf_def_h(l)%end_index(jc,ic) >= mm ) & 5090 CALL restore_surface_elements( surf_def_h(l), & 5091 mm, surf_h(l), m ) 5092 mm = mm + 1 5093 ENDDO 5094 ENDIF 5095 ! 5096 !-- Same for natural-type surfaces. Please note, it is implicitly 5097 !-- assumed that natural surface elements are below urban 5098 !-- urban surface elements if there are several horizontal surfaces 5099 !-- at (j,i). An example would be bridges. 5100 IF ( surf_match_lsm ) THEN 5101 mm = surf_lsm_h%start_index(jc,ic) 5102 DO m = surf_h(l)%start_index(j,i), & 5103 surf_h(l)%end_index(j,i) 5104 IF ( surf_lsm_h%end_index(jc,ic) >= mm ) & 5105 CALL restore_surface_elements( surf_lsm_h, & 5106 mm, surf_h(l), m ) 5107 mm = mm + 1 5108 ENDDO 5109 ENDIF 5110 ! 5111 !-- Same for urban-type surfaces 5112 IF ( surf_match_usm ) THEN 5113 mm = surf_usm_h%start_index(jc,ic) 5114 DO m = surf_h(l)%start_index(j,i), & 5115 surf_h(l)%end_index(j,i) 5116 IF ( surf_usm_h%end_index(jc,ic) >= mm ) & 5117 CALL restore_surface_elements( surf_usm_h, & 5118 mm, surf_h(l), m ) 5119 mm = mm + 1 5120 ENDDO 5121 ENDIF 5122 5123 jc = jc + 1 5124 ENDDO 5125 ic = ic + 1 4943 !-- Same for urban-type surfaces 4944 IF ( surf_match_usm ) THEN 4945 mm = surf_usm_h%start_index(jc,ic) 4946 DO m = surf_h(l)%start_index(j,i), surf_h(l)%end_index(j,i) 4947 IF ( surf_usm_h%end_index(jc,ic) >= mm ) & 4948 CALL restore_surface_elements( surf_usm_h, mm, surf_h(l), m ) 4949 mm = mm + 1 4950 ENDDO 4951 ENDIF 4952 4953 jc = jc + 1 5126 4954 ENDDO 5127 ELSEIF ( vertical_surface .AND. & 5128 .NOT. INDEX( restart_string(1:length), '%start_index' ) /= 0 ) & 5129 THEN 5130 ic = nxlc 5131 DO i = nxlf, nxrf 5132 jc = nysc 5133 DO j = nysf, nynf 5134 ! 5135 !-- Determine type of surface element, i.e. default, natural, 5136 !-- urban, at current grid point. 5137 surf_match_def = surf_def_v(l)%end_index(jc,ic) >= & 5138 surf_def_v(l)%start_index(jc,ic) 5139 surf_match_lsm = surf_lsm_v(l)%end_index(jc,ic) >= & 5140 surf_lsm_v(l)%start_index(jc,ic) 5141 surf_match_usm = surf_usm_v(l)%end_index(jc,ic) >= & 5142 surf_usm_v(l)%start_index(jc,ic) 5143 ! 5144 !-- Write restart data onto default-type surfaces if required. 5145 IF ( surf_match_def ) THEN 5146 ! 5147 !-- Set the start index for the local surface element 5148 mm = surf_def_v(l)%start_index(jc,ic) 5149 ! 5150 !-- For index pair (j,i) on file loop from start to end index, 5151 !-- and in case the local surface element mm is smaller than 5152 !-- the local end index, assign the respective surface data 5153 !-- to this element. 5154 DO m = surf_v(l)%start_index(j,i), & 5155 surf_v(l)%end_index(j,i) 5156 IF ( surf_def_v(l)%end_index(jc,ic) >= mm ) & 5157 CALL restore_surface_elements( surf_def_v(l), & 5158 mm, surf_v(l), m ) 5159 mm = mm + 1 5160 ENDDO 5161 ENDIF 5162 ! 5163 !-- Same for natural-type surfaces. Please note, it is implicitly 5164 !-- assumed that natural surface elements are below urban 5165 !-- urban surface elements if there are several vertical surfaces 5166 !-- at (j,i). An example a terrain elevations with a building on 5167 !-- top. So far, initialization of urban surfaces below natural 5168 !-- surfaces on the same (j,i) is not possible, so that this case 5169 !-- cannot occur. 5170 IF ( surf_match_lsm ) THEN 5171 mm = surf_lsm_v(l)%start_index(jc,ic) 5172 DO m = surf_v(l)%start_index(j,i), & 5173 surf_v(l)%end_index(j,i) 5174 IF ( surf_lsm_v(l)%end_index(jc,ic) >= mm ) & 5175 CALL restore_surface_elements( surf_lsm_v(l), & 5176 mm, surf_v(l), m ) 5177 mm = mm + 1 5178 ENDDO 5179 ENDIF 5180 5181 IF ( surf_match_usm ) THEN 5182 mm = surf_usm_v(l)%start_index(jc,ic) 5183 DO m = surf_v(l)%start_index(j,i), & 5184 surf_v(l)%end_index(j,i) 5185 IF ( surf_usm_v(l)%end_index(jc,ic) >= mm ) & 5186 CALL restore_surface_elements( surf_usm_v(l), & 5187 mm, surf_v(l), m ) 5188 mm = mm + 1 5189 ENDDO 5190 ENDIF 5191 5192 jc = jc + 1 5193 ENDDO 5194 ic = ic + 1 4955 ic = ic + 1 4956 ENDDO 4957 ELSEIF ( vertical_surface .AND. & 4958 .NOT. INDEX( restart_string(1:length), '%start_index' ) /= 0 ) THEN 4959 ic = nxlc 4960 DO i = nxlf, nxrf 4961 jc = nysc 4962 DO j = nysf, nynf 4963 ! 4964 !-- Determine type of surface element, i.e. default, natural, urban, at current grid point. 4965 surf_match_def = surf_def_v(l)%end_index(jc,ic) >= surf_def_v(l)%start_index(jc,ic) 4966 surf_match_lsm = surf_lsm_v(l)%end_index(jc,ic) >= surf_lsm_v(l)%start_index(jc,ic) 4967 surf_match_usm = surf_usm_v(l)%end_index(jc,ic) >= surf_usm_v(l)%start_index(jc,ic) 4968 ! 4969 !-- Write restart data onto default-type surfaces if required. 4970 IF ( surf_match_def ) THEN 4971 ! 4972 !-- Set the start index for the local surface element 4973 mm = surf_def_v(l)%start_index(jc,ic) 4974 ! 4975 !-- For index pair (j,i) on file loop from start to end index, and in case the local 4976 !-- surface element mm is smaller than the local end index, assign the respective 4977 !-- surface data to this element. 4978 DO m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i) 4979 IF ( surf_def_v(l)%end_index(jc,ic) >= mm ) & 4980 CALL restore_surface_elements( surf_def_v(l), mm, surf_v(l), m ) 4981 mm = mm + 1 4982 ENDDO 4983 ENDIF 4984 ! 4985 !-- Same for natural-type surfaces. Please note, it is implicitly assumed that natural 4986 !-- surface elements are below urban surface elements if there are several vertical 4987 !-- surfaces at (j,i). An example a terrain elevations with a building on top. So far, 4988 !-- initialization of urban surfaces below natural surfaces on the same (j,i) is not 4989 !-- possible, so that this case cannot occur. 4990 IF ( surf_match_lsm ) THEN 4991 mm = surf_lsm_v(l)%start_index(jc,ic) 4992 DO m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i) 4993 IF ( surf_lsm_v(l)%end_index(jc,ic) >= mm ) & 4994 CALL restore_surface_elements( surf_lsm_v(l), mm, surf_v(l), m ) 4995 mm = mm + 1 4996 ENDDO 4997 ENDIF 4998 4999 IF ( surf_match_usm ) THEN 5000 mm = surf_usm_v(l)%start_index(jc,ic) 5001 DO m = surf_v(l)%start_index(j,i), surf_v(l)%end_index(j,i) 5002 IF ( surf_usm_v(l)%end_index(jc,ic) >= mm ) & 5003 CALL restore_surface_elements( surf_usm_v(l), mm, surf_v(l), m ) 5004 mm = mm + 1 5005 ENDDO 5006 ENDIF 5007 5008 jc = jc + 1 5195 5009 ENDDO 5196 ENDIF 5010 ic = ic + 1 5011 ENDDO 5012 ENDIF 5197 5013 5198 5014 CONTAINS 5199 !------------------------------------------------------------------------------ !5015 !--------------------------------------------------------------------------------------------------! 5200 5016 ! Description: 5201 5017 ! ------------ 5202 5018 !> Restores surface elements back on its respective type. 5203 !------------------------------------------------------------------------------! 5204 SUBROUTINE restore_surface_elements( surf_target, m_target, & 5205 surf_file, m_file ) 5206 5207 IMPLICIT NONE 5208 5209 INTEGER(iwp) :: m_file !< respective surface-element index of current surface array 5210 INTEGER(iwp) :: m_target !< respecitve surface-element index of surface array on file 5211 INTEGER(iwp) :: lsp !< running index chemical species 5212 5213 TYPE( surf_type ) :: surf_target !< target surface type 5214 TYPE( surf_type ) :: surf_file !< surface type on file 5215 5216 5217 IF ( INDEX( restart_string(1:length), '%us' ) /= 0 ) THEN 5218 IF ( ALLOCATED( surf_target%us ) .AND. & 5219 ALLOCATED( surf_file%us ) ) & 5220 surf_target%us(m_target) = surf_file%us(m_file) 5221 ENDIF 5222 5223 IF ( INDEX( restart_string(1:length), '%ol' ) /= 0 ) THEN 5224 IF ( ALLOCATED( surf_target%ol ) .AND. & 5225 ALLOCATED( surf_file%ol ) ) & 5226 surf_target%ol(m_target) = surf_file%ol(m_file) 5227 ENDIF 5228 5229 IF ( INDEX( restart_string(1:length), '%pt_surface' ) /= 0 ) THEN 5230 IF ( ALLOCATED( surf_target%pt_surface ) .AND. & 5231 ALLOCATED( surf_file%pt_surface ) ) & 5232 surf_target%pt_surface(m_target) = surf_file%pt_surface(m_file) 5233 ENDIF 5234 5235 IF ( INDEX( restart_string(1:length), '%q_surface' ) /= 0 ) THEN 5236 IF ( ALLOCATED( surf_target%q_surface ) .AND. & 5237 ALLOCATED( surf_file%q_surface ) ) & 5238 surf_target%q_surface(m_target) = surf_file%q_surface(m_file) 5239 ENDIF 5240 5241 IF ( INDEX( restart_string(1:length), '%vpt_surface' ) /= 0 ) THEN 5242 IF ( ALLOCATED( surf_target%vpt_surface ) .AND. & 5243 ALLOCATED( surf_file%vpt_surface ) ) & 5244 surf_target%vpt_surface(m_target) = surf_file%vpt_surface(m_file) 5245 ENDIF 5246 5247 IF ( INDEX( restart_string(1:length), '%usws' ) /= 0 ) THEN 5248 IF ( ALLOCATED( surf_target%usws ) .AND. & 5249 ALLOCATED( surf_file%usws ) ) & 5250 surf_target%usws(m_target) = surf_file%usws(m_file) 5251 ENDIF 5252 5253 IF ( INDEX( restart_string(1:length), '%vsws' ) /= 0 ) THEN 5254 IF ( ALLOCATED( surf_target%vsws ) .AND. & 5255 ALLOCATED( surf_file%vsws ) ) & 5256 surf_target%vsws(m_target) = surf_file%vsws(m_file) 5257 ENDIF 5258 5259 IF ( INDEX( restart_string(1:length), '%ts' ) /= 0 ) THEN 5260 IF ( ALLOCATED( surf_target%ts ) .AND. & 5261 ALLOCATED( surf_file%ts ) ) & 5262 surf_target%ts(m_target) = surf_file%ts(m_file) 5263 ENDIF 5264 5265 IF ( INDEX( restart_string(1:length), '%shf' ) /= 0 ) THEN 5266 IF ( ALLOCATED( surf_target%shf ) .AND. & 5267 ALLOCATED( surf_file%shf ) ) & 5268 surf_target%shf(m_target) = surf_file%shf(m_file) 5269 ENDIF 5270 5271 IF ( INDEX( restart_string(1:length), '%qs' ) /= 0 ) THEN 5272 IF ( ALLOCATED( surf_target%qs ) .AND. & 5273 ALLOCATED( surf_file%qs ) ) & 5274 surf_target%qs(m_target) = surf_file%qs(m_file) 5275 ENDIF 5276 5277 IF ( INDEX( restart_string(1:length), '%qsws' ) /= 0 ) THEN 5278 IF ( ALLOCATED( surf_target%qsws ) .AND. & 5279 ALLOCATED( surf_file%qsws ) ) & 5280 surf_target%qsws(m_target) = surf_file%qsws(m_file) 5281 ENDIF 5282 5283 IF ( INDEX( restart_string(1:length), '%ss' ) /= 0 ) THEN 5284 IF ( ALLOCATED( surf_target%ss ) .AND. & 5285 ALLOCATED( surf_file%ss ) ) & 5286 surf_target%ss(m_target) = surf_file%ss(m_file) 5287 ENDIF 5288 5289 IF ( INDEX( restart_string(1:length), '%ssws' ) /= 0 ) THEN 5290 IF ( ALLOCATED( surf_target%ssws ) .AND. & 5291 ALLOCATED( surf_file%ssws ) ) & 5292 surf_target%ssws(m_target) = surf_file%ssws(m_file) 5293 ENDIF 5294 5295 IF ( INDEX( restart_string(1:length), '%css' ) /= 0 ) THEN 5296 IF ( ALLOCATED( surf_target%css ) .AND. & 5297 ALLOCATED( surf_file%css ) ) THEN 5298 DO lsp = 1, nvar 5299 surf_target%css(lsp,m_target) = surf_file%css(lsp,m_file) 5300 ENDDO 5301 ENDIF 5302 ENDIF 5303 IF ( INDEX( restart_string(1:length), '%cssws' ) /= 0 ) THEN 5304 IF ( ALLOCATED( surf_target%cssws ) .AND. & 5305 ALLOCATED( surf_file%cssws ) ) THEN 5306 DO lsp = 1, nvar 5307 surf_target%cssws(lsp,m_target) = surf_file%cssws(lsp,m_file) 5308 ENDDO 5309 ENDIF 5310 ENDIF 5311 5312 IF ( INDEX( restart_string(1:length), '%qcs' ) /= 0 ) THEN 5313 IF ( ALLOCATED( surf_target%qcs ) .AND. & 5314 ALLOCATED( surf_file%qcs ) ) & 5315 surf_target%qcs(m_target) = surf_file%qcs(m_file) 5316 ENDIF 5317 5318 IF ( INDEX( restart_string(1:length), '%qcsws' ) /= 0 ) THEN 5319 IF ( ALLOCATED( surf_target%qcsws ) .AND. & 5320 ALLOCATED( surf_file%qcsws ) ) & 5321 surf_target%qcsws(m_target) = surf_file%qcsws(m_file) 5322 ENDIF 5323 5324 IF ( INDEX( restart_string(1:length), '%ncs' ) /= 0 ) THEN 5325 IF ( ALLOCATED( surf_target%ncs ) .AND. & 5326 ALLOCATED( surf_file%ncs ) ) & 5327 surf_target%ncs(m_target) = surf_file%ncs(m_file) 5328 ENDIF 5329 5330 IF ( INDEX( restart_string(1:length), '%ncsws' ) /= 0 ) THEN 5331 IF ( ALLOCATED( surf_target%ncsws ) .AND. & 5332 ALLOCATED( surf_file%ncsws ) ) & 5333 surf_target%ncsws(m_target) = surf_file%ncsws(m_file) 5334 ENDIF 5335 5336 IF ( INDEX( restart_string(1:length), '%qis' ) /= 0 ) THEN 5337 IF ( ALLOCATED( surf_target%qis ) .AND. & 5338 ALLOCATED( surf_file%qis ) ) & 5339 surf_target%qis(m_target) = surf_file%qis(m_file) 5340 ENDIF 5341 5342 IF ( INDEX( restart_string(1:length), '%qisws' ) /= 0 ) THEN 5343 IF ( ALLOCATED( surf_target%qisws ) .AND. & 5344 ALLOCATED( surf_file%qisws ) ) & 5345 surf_target%qisws(m_target) = surf_file%qisws(m_file) 5346 ENDIF 5347 5348 IF ( INDEX( restart_string(1:length), '%nis' ) /= 0 ) THEN 5349 IF ( ALLOCATED( surf_target%nis ) .AND. & 5350 ALLOCATED( surf_file%nis ) ) & 5351 surf_target%nis(m_target) = surf_file%nis(m_file) 5352 ENDIF 5353 5354 IF ( INDEX( restart_string(1:length), '%nisws' ) /= 0 ) THEN 5355 IF ( ALLOCATED( surf_target%nisws ) .AND. & 5356 ALLOCATED( surf_file%nisws ) ) & 5357 surf_target%nisws(m_target) = surf_file%nisws(m_file) 5358 ENDIF 5359 5360 IF ( INDEX( restart_string(1:length), '%qrs' ) /= 0 ) THEN 5361 IF ( ALLOCATED( surf_target%qrs ) .AND. & 5362 ALLOCATED( surf_file%qrs ) ) & 5363 surf_target%qrs(m_target) = surf_file%qrs(m_file) 5364 ENDIF 5365 5366 IF ( INDEX( restart_string(1:length), '%qrsws' ) /= 0 ) THEN 5367 IF ( ALLOCATED( surf_target%qrsws ) .AND. & 5368 ALLOCATED( surf_file%qrsws ) ) & 5369 surf_target%qrsws(m_target) = surf_file%qrsws(m_file) 5370 ENDIF 5371 5372 IF ( INDEX( restart_string(1:length), '%nrs' ) /= 0 ) THEN 5373 IF ( ALLOCATED( surf_target%nrs ) .AND. & 5374 ALLOCATED( surf_file%nrs ) ) & 5375 surf_target%nrs(m_target) = surf_file%nrs(m_file) 5376 ENDIF 5377 5378 IF ( INDEX( restart_string(1:length), '%nrsws' ) /= 0 ) THEN 5379 IF ( ALLOCATED( surf_target%nrsws ) .AND. & 5380 ALLOCATED( surf_file%nrsws ) ) & 5381 surf_target%nrsws(m_target) = surf_file%nrsws(m_file) 5382 ENDIF 5383 5384 IF ( INDEX( restart_string(1:length), '%sasws' ) /= 0 ) THEN 5385 IF ( ALLOCATED( surf_target%sasws ) .AND. & 5386 ALLOCATED( surf_file%sasws ) ) & 5387 surf_target%sasws(m_target) = surf_file%sasws(m_file) 5388 ENDIF 5389 5390 IF ( INDEX( restart_string(1:length), '%mom_uv' ) /= 0 ) THEN 5391 IF ( ALLOCATED( surf_target%mom_flux_uv ) .AND. & 5392 ALLOCATED( surf_file%mom_flux_uv ) ) & 5393 surf_target%mom_flux_uv(m_target) = & 5394 surf_file%mom_flux_uv(m_file) 5395 ENDIF 5396 5397 IF ( INDEX( restart_string(1:length), '%mom_w' ) /= 0 ) THEN 5398 IF ( ALLOCATED( surf_target%mom_flux_w ) .AND. & 5399 ALLOCATED( surf_file%mom_flux_w ) ) & 5400 surf_target%mom_flux_w(m_target) = & 5401 surf_file%mom_flux_w(m_file) 5402 ENDIF 5403 5404 IF ( INDEX( restart_string(1:length), '%mom_tke' ) /= 0 ) THEN 5405 IF ( ALLOCATED( surf_target%mom_flux_tke ) .AND. & 5406 ALLOCATED( surf_file%mom_flux_tke ) ) & 5407 surf_target%mom_flux_tke(0:1,m_target) = & 5408 surf_file%mom_flux_tke(0:1,m_file) 5409 ENDIF 5410 5411 5412 END SUBROUTINE restore_surface_elements 5413 5414 5415 END SUBROUTINE surface_rrd_local_ftn 5416 5417 5418 !------------------------------------------------------------------------------! 5019 !--------------------------------------------------------------------------------------------------! 5020 SUBROUTINE restore_surface_elements( surf_target, m_target, surf_file, m_file ) 5021 5022 IMPLICIT NONE 5023 5024 INTEGER(iwp) :: m_file !< respective surface-element index of current surface array 5025 INTEGER(iwp) :: m_target !< respecitve surface-element index of surface array on file 5026 INTEGER(iwp) :: lsp !< running index chemical species 5027 5028 TYPE(surf_type) :: surf_target !< target surface type 5029 TYPE(surf_type) :: surf_file !< surface type on file 5030 5031 5032 IF ( INDEX( restart_string(1:length), '%us' ) /= 0 ) THEN 5033 IF ( ALLOCATED( surf_target%us ) .AND. ALLOCATED( surf_file%us ) ) & 5034 surf_target%us(m_target) = surf_file%us(m_file) 5035 ENDIF 5036 5037 IF ( INDEX( restart_string(1:length), '%ol' ) /= 0 ) THEN 5038 IF ( ALLOCATED( surf_target%ol ) .AND. ALLOCATED( surf_file%ol ) ) & 5039 surf_target%ol(m_target) = surf_file%ol(m_file) 5040 ENDIF 5041 5042 IF ( INDEX( restart_string(1:length), '%pt_surface' ) /= 0 ) THEN 5043 IF ( ALLOCATED( surf_target%pt_surface ) .AND. ALLOCATED( surf_file%pt_surface ) ) & 5044 surf_target%pt_surface(m_target) = surf_file%pt_surface(m_file) 5045 ENDIF 5046 5047 IF ( INDEX( restart_string(1:length), '%q_surface' ) /= 0 ) THEN 5048 IF ( ALLOCATED( surf_target%q_surface ) .AND. ALLOCATED( surf_file%q_surface ) ) & 5049 surf_target%q_surface(m_target) = surf_file%q_surface(m_file) 5050 ENDIF 5051 5052 IF ( INDEX( restart_string(1:length), '%vpt_surface' ) /= 0 ) THEN 5053 IF ( ALLOCATED( surf_target%vpt_surface ) .AND. ALLOCATED( surf_file%vpt_surface ) ) & 5054 surf_target%vpt_surface(m_target) = surf_file%vpt_surface(m_file) 5055 ENDIF 5056 5057 IF ( INDEX( restart_string(1:length), '%usws' ) /= 0 ) THEN 5058 IF ( ALLOCATED( surf_target%usws ) .AND. ALLOCATED( surf_file%usws ) ) & 5059 surf_target%usws(m_target) = surf_file%usws(m_file) 5060 ENDIF 5061 5062 IF ( INDEX( restart_string(1:length), '%vsws' ) /= 0 ) THEN 5063 IF ( ALLOCATED( surf_target%vsws ) .AND. ALLOCATED( surf_file%vsws ) ) & 5064 surf_target%vsws(m_target) = surf_file%vsws(m_file) 5065 ENDIF 5066 5067 IF ( INDEX( restart_string(1:length), '%ts' ) /= 0 ) THEN 5068 IF ( ALLOCATED( surf_target%ts ) .AND. ALLOCATED( surf_file%ts ) ) & 5069 surf_target%ts(m_target) = surf_file%ts(m_file) 5070 ENDIF 5071 5072 IF ( INDEX( restart_string(1:length), '%shf' ) /= 0 ) THEN 5073 IF ( ALLOCATED( surf_target%shf ) .AND. ALLOCATED( surf_file%shf ) ) & 5074 surf_target%shf(m_target) = surf_file%shf(m_file) 5075 ENDIF 5076 5077 IF ( INDEX( restart_string(1:length), '%qs' ) /= 0 ) THEN 5078 IF ( ALLOCATED( surf_target%qs ) .AND. ALLOCATED( surf_file%qs ) ) & 5079 surf_target%qs(m_target) = surf_file%qs(m_file) 5080 ENDIF 5081 5082 IF ( INDEX( restart_string(1:length), '%qsws' ) /= 0 ) THEN 5083 IF ( ALLOCATED( surf_target%qsws ) .AND. ALLOCATED( surf_file%qsws ) ) & 5084 surf_target%qsws(m_target) = surf_file%qsws(m_file) 5085 ENDIF 5086 5087 IF ( INDEX( restart_string(1:length), '%ss' ) /= 0 ) THEN 5088 IF ( ALLOCATED( surf_target%ss ) .AND. ALLOCATED( surf_file%ss ) ) & 5089 surf_target%ss(m_target) = surf_file%ss(m_file) 5090 ENDIF 5091 5092 IF ( INDEX( restart_string(1:length), '%ssws' ) /= 0 ) THEN 5093 IF ( ALLOCATED( surf_target%ssws ) .AND. ALLOCATED( surf_file%ssws ) ) & 5094 surf_target%ssws(m_target) = surf_file%ssws(m_file) 5095 ENDIF 5096 5097 IF ( INDEX( restart_string(1:length), '%css' ) /= 0 ) THEN 5098 IF ( ALLOCATED( surf_target%css ) .AND. ALLOCATED( surf_file%css ) ) THEN 5099 DO lsp = 1, nvar 5100 surf_target%css(lsp,m_target) = surf_file%css(lsp,m_file) 5101 ENDDO 5102 ENDIF 5103 ENDIF 5104 IF ( INDEX( restart_string(1:length), '%cssws' ) /= 0 ) THEN 5105 IF ( ALLOCATED( surf_target%cssws ) .AND. ALLOCATED( surf_file%cssws ) ) THEN 5106 DO lsp = 1, nvar 5107 surf_target%cssws(lsp,m_target) = surf_file%cssws(lsp,m_file) 5108 ENDDO 5109 ENDIF 5110 ENDIF 5111 5112 IF ( INDEX( restart_string(1:length), '%qcs' ) /= 0 ) THEN 5113 IF ( ALLOCATED( surf_target%qcs ) .AND. ALLOCATED( surf_file%qcs ) ) & 5114 surf_target%qcs(m_target) = surf_file%qcs(m_file) 5115 ENDIF 5116 5117 IF ( INDEX( restart_string(1:length), '%qcsws' ) /= 0 ) THEN 5118 IF ( ALLOCATED( surf_target%qcsws ) .AND. ALLOCATED( surf_file%qcsws ) ) & 5119 surf_target%qcsws(m_target) = surf_file%qcsws(m_file) 5120 ENDIF 5121 5122 IF ( INDEX( restart_string(1:length), '%ncs' ) /= 0 ) THEN 5123 IF ( ALLOCATED( surf_target%ncs ) .AND. ALLOCATED( surf_file%ncs ) ) & 5124 surf_target%ncs(m_target) = surf_file%ncs(m_file) 5125 ENDIF 5126 5127 IF ( INDEX( restart_string(1:length), '%ncsws' ) /= 0 ) THEN 5128 IF ( ALLOCATED( surf_target%ncsws ) .AND. ALLOCATED( surf_file%ncsws ) ) & 5129 surf_target%ncsws(m_target) = surf_file%ncsws(m_file) 5130 ENDIF 5131 5132 IF ( INDEX( restart_string(1:length), '%qis' ) /= 0 ) THEN 5133 IF ( ALLOCATED( surf_target%qis ) .AND. ALLOCATED( surf_file%qis ) ) & 5134 surf_target%qis(m_target) = surf_file%qis(m_file) 5135 ENDIF 5136 5137 IF ( INDEX( restart_string(1:length), '%qisws' ) /= 0 ) THEN 5138 IF ( ALLOCATED( surf_target%qisws ) .AND. ALLOCATED( surf_file%qisws ) ) & 5139 surf_target%qisws(m_target) = surf_file%qisws(m_file) 5140 ENDIF 5141 5142 IF ( INDEX( restart_string(1:length), '%nis' ) /= 0 ) THEN 5143 IF ( ALLOCATED( surf_target%nis ) .AND. ALLOCATED( surf_file%nis ) ) & 5144 surf_target%nis(m_target) = surf_file%nis(m_file) 5145 ENDIF 5146 5147 IF ( INDEX( restart_string(1:length), '%nisws' ) /= 0 ) THEN 5148 IF ( ALLOCATED( surf_target%nisws ) .AND. ALLOCATED( surf_file%nisws ) ) & 5149 surf_target%nisws(m_target) = surf_file%nisws(m_file) 5150 ENDIF 5151 5152 IF ( INDEX( restart_string(1:length), '%qrs' ) /= 0 ) THEN 5153 IF ( ALLOCATED( surf_target%qrs ) .AND. ALLOCATED( surf_file%qrs ) ) & 5154 surf_target%qrs(m_target) = surf_file%qrs(m_file) 5155 ENDIF 5156 5157 IF ( INDEX( restart_string(1:length), '%qrsws' ) /= 0 ) THEN 5158 IF ( ALLOCATED( surf_target%qrsws ) .AND. ALLOCATED( surf_file%qrsws ) ) & 5159 surf_target%qrsws(m_target) = surf_file%qrsws(m_file) 5160 ENDIF 5161 5162 IF ( INDEX( restart_string(1:length), '%nrs' ) /= 0 ) THEN 5163 IF ( ALLOCATED( surf_target%nrs ) .AND. ALLOCATED( surf_file%nrs ) ) & 5164 surf_target%nrs(m_target) = surf_file%nrs(m_file) 5165 ENDIF 5166 5167 IF ( INDEX( restart_string(1:length), '%nrsws' ) /= 0 ) THEN 5168 IF ( ALLOCATED( surf_target%nrsws ) .AND. ALLOCATED( surf_file%nrsws ) ) & 5169 surf_target%nrsws(m_target) = surf_file%nrsws(m_file) 5170 ENDIF 5171 5172 IF ( INDEX( restart_string(1:length), '%sasws' ) /= 0 ) THEN 5173 IF ( ALLOCATED( surf_target%sasws ) .AND. ALLOCATED( surf_file%sasws ) ) & 5174 surf_target%sasws(m_target) = surf_file%sasws(m_file) 5175 ENDIF 5176 5177 IF ( INDEX( restart_string(1:length), '%mom_uv' ) /= 0 ) THEN 5178 IF ( ALLOCATED( surf_target%mom_flux_uv ) .AND. ALLOCATED( surf_file%mom_flux_uv ) ) & 5179 surf_target%mom_flux_uv(m_target) = surf_file%mom_flux_uv(m_file) 5180 ENDIF 5181 5182 IF ( INDEX( restart_string(1:length), '%mom_w' ) /= 0 ) THEN 5183 IF ( ALLOCATED( surf_target%mom_flux_w ) .AND. ALLOCATED( surf_file%mom_flux_w ) ) & 5184 surf_target%mom_flux_w(m_target) = surf_file%mom_flux_w(m_file) 5185 ENDIF 5186 5187 IF ( INDEX( restart_string(1:length), '%mom_tke' ) /= 0 ) THEN 5188 IF ( ALLOCATED( surf_target%mom_flux_tke ) .AND. & 5189 ALLOCATED( surf_file%mom_flux_tke ) ) & 5190 surf_target%mom_flux_tke(0:1,m_target) = surf_file%mom_flux_tke(0:1,m_file) 5191 ENDIF 5192 5193 5194 END SUBROUTINE restore_surface_elements 5195 5196 5197 END SUBROUTINE surface_rrd_local_ftn 5198 5199 5200 !--------------------------------------------------------------------------------------------------! 5419 5201 ! Description: 5420 5202 ! ------------ 5421 !> Reads surface-related restart data in MPI-IO format. 5422 !> TO_DO: this routine needs to be adjusted forcyclic_fill mode5423 !------------------------------------------------------------------------------ !5203 !> Reads surface-related restart data in MPI-IO format. TO_DO: this routine needs to be adjusted for 5204 !> cyclic_fill mode 5205 !--------------------------------------------------------------------------------------------------! 5424 5206 SUBROUTINE surface_rrd_local_mpi 5425 5207 … … 5435 5217 LOGICAL :: ldum !< dummy variable 5436 5218 5437 TYPE(surf_type), DIMENSION(0:2) :: surf_h 5438 TYPE(surf_type), DIMENSION(0:3) :: surf_v 5219 TYPE(surf_type), DIMENSION(0:2) :: surf_h !< gathered horizontal surfaces, contains all surface types 5220 TYPE(surf_type), DIMENSION(0:3) :: surf_v !< gathered vertical surfaces, contains all surface types 5439 5221 5440 5222 ! … … 5446 5228 DO l = 0, 2 5447 5229 5448 IF ( ns_h_on_file(l) == 0 ) CYCLE !< no data of this surface type on file5230 IF ( ns_h_on_file(l) == 0 ) CYCLE !< No data of this surface type on file 5449 5231 5450 5232 IF ( ALLOCATED( surf_h(l)%start_index ) ) CALL deallocate_surface_attributes_h( surf_h(l) ) … … 5452 5234 CALL allocate_surface_attributes_h( surf_h(l), nys, nyn, nxl, nxr ) 5453 5235 5454 WRITE( dum, '(I1)') 5236 WRITE( dum, '(I1)') l 5455 5237 5456 5238 CALL rrd_mpi_io( 'surf_h(' // dum // ')%start_index', surf_h(l)%start_index ) … … 5458 5240 CALL rrd_mpi_io( 'global_start_index_h_' // dum , global_start_index ) 5459 5241 5460 CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index, ldum, global_start_index ) 5242 CALL rd_mpi_io_surface_filetypes( surf_h(l)%start_index, surf_h(l)%end_index, ldum, & 5243 global_start_index ) 5461 5244 5462 5245 IF ( ALLOCATED ( surf_h(l)%us ) ) THEN … … 5582 5365 DO l = 0, 3 5583 5366 5584 IF ( ns_v_on_file(l) == 0 ) CYCLE !< no data of this surface type on file5367 IF ( ns_v_on_file(l) == 0 ) CYCLE !< No data of this surface type on file 5585 5368 5586 5369 IF ( ALLOCATED( surf_v(l)%start_index ) ) CALL deallocate_surface_attributes_v( surf_v(l) ) … … 5588 5371 CALL allocate_surface_attributes_v( surf_v(l), nys, nyn, nxl, nxr ) 5589 5372 5590 WRITE( dum, '(I1)' ) 5373 WRITE( dum, '(I1)' ) l 5591 5374 5592 5375 CALL rrd_mpi_io( 'surf_v(' // dum // ')%start_index', surf_v(l)%start_index ) … … 5706 5489 5707 5490 IF ( ALLOCATED ( surf_v(l)%mom_flux_uv ) ) THEN 5708 CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_uv', surf_v(l)%mom_flux_uv )5491 CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_uv', surf_v(l)%mom_flux_uv ) 5709 5492 ENDIF 5710 5493 5711 5494 IF ( ALLOCATED ( surf_v(l)%mom_flux_w ) ) THEN 5712 CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_w', surf_v(l)%mom_flux_w )5495 CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_w', surf_v(l)%mom_flux_w ) 5713 5496 ENDIF 5714 5497 5715 5498 IF ( ALLOCATED ( surf_v(l)%mom_flux_tke ) ) THEN 5716 CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_tke', surf_v(l)%mom_flux_tke )5499 CALL rrd_mpi_io_surface( 'surf_v(' // dum // ')%mom_tke', surf_v(l)%mom_flux_tke ) 5717 5500 ENDIF 5718 5501 … … 5722 5505 !-- Redistribute surface elements on its respective type. 5723 5506 5724 DO l = 0 5507 DO l = 0, 2 5725 5508 CALL restore_surface_elements( surf_def_h(l), surf_h(l) ) 5726 5509 CALL restore_surface_elements( surf_lsm_h, surf_h(l) ) … … 5728 5511 ENDDO 5729 5512 5730 DO l = 0 5513 DO l = 0, 3 5731 5514 CALL restore_surface_elements( surf_def_v(l), surf_v(l) ) 5732 5515 CALL restore_surface_elements( surf_lsm_v(l), surf_v(l) ) … … 5736 5519 CONTAINS 5737 5520 5738 SUBROUTINE restore_surface_elements( surf_target, surf_file ) 5739 5740 IMPLICIT NONE 5741 5742 INTEGER(iwp) :: lsp !< running index chemical species 5743 5744 TYPE( surf_type ) :: surf_target !< target surface type 5745 TYPE( surf_type ) :: surf_file !< surface type on file 5746 5747 5748 IF ( ALLOCATED( surf_target%us ) .AND. ALLOCATED( surf_file%us ) ) THEN 5749 surf_target%us = surf_file%us 5750 ENDIF 5751 5752 IF ( ALLOCATED( surf_target%ol ) .AND. & 5753 ALLOCATED( surf_file%ol ) ) & 5754 surf_target%ol = surf_file%ol 5755 5756 IF ( ALLOCATED( surf_target%pt_surface ) .AND. & 5757 ALLOCATED( surf_file%pt_surface ) ) & 5758 surf_target%pt_surface = surf_file%pt_surface 5759 5760 IF ( ALLOCATED( surf_target%q_surface ) .AND. & 5761 ALLOCATED( surf_file%q_surface ) ) & 5762 surf_target%q_surface = surf_file%q_surface 5763 5764 IF ( ALLOCATED( surf_target%vpt_surface ) .AND. & 5765 ALLOCATED( surf_file%vpt_surface ) ) & 5766 surf_target%vpt_surface = surf_file%vpt_surface 5767 5768 IF ( ALLOCATED( surf_target%usws ) .AND. & 5769 ALLOCATED( surf_file%usws ) ) & 5770 surf_target%usws = surf_file%usws 5771 5772 IF ( ALLOCATED( surf_target%vsws ) .AND. & 5773 ALLOCATED( surf_file%vsws ) ) & 5774 surf_target%vsws = surf_file%vsws 5775 5776 IF ( ALLOCATED( surf_target%ts ) .AND. & 5777 ALLOCATED( surf_file%ts ) ) & 5778 surf_target%ts = surf_file%ts 5779 5780 IF ( ALLOCATED( surf_target%shf ) .AND. & 5781 ALLOCATED( surf_file%shf ) ) & 5782 surf_target%shf = surf_file%shf 5783 5784 IF ( ALLOCATED( surf_target%qs ) .AND. & 5785 ALLOCATED( surf_file%qs ) ) & 5786 surf_target%qs = surf_file%qs 5787 5788 IF ( ALLOCATED( surf_target%qsws ) .AND. & 5789 ALLOCATED( surf_file%qsws ) ) & 5790 surf_target%qsws = surf_file%qsws 5791 5792 IF ( ALLOCATED( surf_target%ss ) .AND. & 5793 ALLOCATED( surf_file%ss ) ) & 5794 surf_target%ss = surf_file%ss 5795 5796 IF ( ALLOCATED( surf_target%ssws ) .AND. & 5797 ALLOCATED( surf_file%ssws ) ) & 5798 surf_target%ssws = surf_file%ssws 5799 5800 IF ( ALLOCATED( surf_target%css ) .AND. & 5801 ALLOCATED( surf_file%css ) ) THEN 5802 DO lsp = 1, nvar 5803 surf_target%css(lsp,:) = surf_file%css(lsp,:) 5804 ENDDO 5805 ENDIF 5806 5807 IF ( ALLOCATED( surf_target%cssws ) .AND. & 5808 ALLOCATED( surf_file%cssws ) ) THEN 5809 DO lsp = 1, nvar 5810 surf_target%cssws(lsp,:) = surf_file%cssws(lsp,:) 5811 ENDDO 5812 ENDIF 5813 IF ( ALLOCATED( surf_target%qcs ) .AND. & 5814 ALLOCATED( surf_file%qcs ) ) & 5815 surf_target%qcs = surf_file%qcs 5816 IF ( ALLOCATED( surf_target%qcsws ) .AND. & 5817 ALLOCATED( surf_file%qcsws ) ) & 5818 surf_target%qcsws = surf_file%qcsws 5819 IF ( ALLOCATED( surf_target%ncs ) .AND. & 5820 ALLOCATED( surf_file%ncs ) ) & 5821 surf_target%ncs = surf_file%ncs 5822 IF ( ALLOCATED( surf_target%ncsws ) .AND. & 5823 ALLOCATED( surf_file%ncsws ) ) & 5824 surf_target%ncsws = surf_file%ncsws 5825 IF ( ALLOCATED( surf_target%qrs ) .AND. & 5826 ALLOCATED( surf_file%qrs ) ) & 5827 surf_target%qrs = surf_file%qrs 5828 IF ( ALLOCATED( surf_target%qrsws ) .AND. & 5829 ALLOCATED( surf_file%qrsws ) ) & 5830 surf_target%qrsws = surf_file%qrsws 5831 IF ( ALLOCATED( surf_target%nrs ) .AND. & 5832 ALLOCATED( surf_file%nrs ) ) & 5833 surf_target%nrs = surf_file%nrs 5834 5835 IF ( ALLOCATED( surf_target%nrsws ) .AND. & 5836 ALLOCATED( surf_file%nrsws ) ) & 5837 surf_target%nrsws = surf_file%nrsws 5838 IF ( ALLOCATED( surf_target%sasws ) .AND. & 5839 ALLOCATED( surf_file%sasws ) ) & 5840 surf_target%sasws = surf_file%sasws 5841 IF ( ALLOCATED( surf_target%mom_flux_uv ) .AND. & 5842 ALLOCATED( surf_file%mom_flux_uv ) ) & 5843 surf_target%mom_flux_uv = & 5844 surf_file%mom_flux_uv 5845 IF ( ALLOCATED( surf_target%mom_flux_w ) .AND. & 5846 ALLOCATED( surf_file%mom_flux_w ) ) & 5847 surf_target%mom_flux_w = & 5848 surf_file%mom_flux_w 5849 IF ( ALLOCATED( surf_target%mom_flux_tke ) .AND. & 5850 ALLOCATED( surf_file%mom_flux_tke ) ) & 5851 surf_target%mom_flux_tke(0:1,:) = & 5852 surf_file%mom_flux_tke(0:1,:) 5853 5854 5855 END SUBROUTINE restore_surface_elements 5521 SUBROUTINE restore_surface_elements( surf_target, surf_file ) 5522 5523 IMPLICIT NONE 5524 5525 INTEGER(iwp) :: lsp !< running index chemical species 5526 5527 TYPE(surf_type) :: surf_target !< target surface type 5528 TYPE(surf_type) :: surf_file !< surface type on file 5529 5530 5531 IF ( ALLOCATED( surf_target%us ) .AND. ALLOCATED( surf_file%us ) ) THEN 5532 surf_target%us = surf_file%us 5533 ENDIF 5534 5535 IF ( ALLOCATED( surf_target%ol ) .AND. ALLOCATED( surf_file%ol ) ) & 5536 surf_target%ol = surf_file%ol 5537 5538 IF ( ALLOCATED( surf_target%pt_surface ) .AND. ALLOCATED( surf_file%pt_surface ) ) & 5539 surf_target%pt_surface = surf_file%pt_surface 5540 5541 IF ( ALLOCATED( surf_target%q_surface ) .AND. ALLOCATED( surf_file%q_surface ) ) & 5542 surf_target%q_surface = surf_file%q_surface 5543 5544 IF ( ALLOCATED( surf_target%vpt_surface ) .AND. ALLOCATED( surf_file%vpt_surface ) ) & 5545 surf_target%vpt_surface = surf_file%vpt_surface 5546 5547 IF ( ALLOCATED( surf_target%usws ) .AND. ALLOCATED( surf_file%usws ) ) & 5548 surf_target%usws = surf_file%usws 5549 5550 IF ( ALLOCATED( surf_target%vsws ) .AND. ALLOCATED( surf_file%vsws ) ) & 5551 surf_target%vsws = surf_file%vsws 5552 5553 IF ( ALLOCATED( surf_target%ts ) .AND. ALLOCATED( surf_file%ts ) ) & 5554 surf_target%ts = surf_file%ts 5555 5556 IF ( ALLOCATED( surf_target%shf ) .AND. ALLOCATED( surf_file%shf ) ) & 5557 surf_target%shf = surf_file%shf 5558 5559 IF ( ALLOCATED( surf_target%qs ) .AND. ALLOCATED( surf_file%qs ) ) & 5560 surf_target%qs = surf_file%qs 5561 5562 IF ( ALLOCATED( surf_target%qsws ) .AND. ALLOCATED( surf_file%qsws ) ) & 5563 surf_target%qsws = surf_file%qsws 5564 5565 IF ( ALLOCATED( surf_target%ss ) .AND. ALLOCATED( surf_file%ss ) ) & 5566 surf_target%ss = surf_file%ss 5567 5568 IF ( ALLOCATED( surf_target%ssws ) .AND. ALLOCATED( surf_file%ssws ) ) & 5569 surf_target%ssws = surf_file%ssws 5570 5571 IF ( ALLOCATED( surf_target%css ) .AND. ALLOCATED( surf_file%css ) ) THEN 5572 DO lsp = 1, nvar 5573 surf_target%css(lsp,:) = surf_file%css(lsp,:) 5574 ENDDO 5575 ENDIF 5576 5577 IF ( ALLOCATED( surf_target%cssws ) .AND. ALLOCATED( surf_file%cssws ) ) THEN 5578 DO lsp = 1, nvar 5579 surf_target%cssws(lsp,:) = surf_file%cssws(lsp,:) 5580 ENDDO 5581 ENDIF 5582 IF ( ALLOCATED( surf_target%qcs ) .AND. ALLOCATED( surf_file%qcs ) ) & 5583 surf_target%qcs = surf_file%qcs 5584 IF ( ALLOCATED( surf_target%qcsws ) .AND. ALLOCATED( surf_file%qcsws ) ) & 5585 surf_target%qcsws = surf_file%qcsws 5586 IF ( ALLOCATED( surf_target%ncs ) .AND. ALLOCATED( surf_file%ncs ) ) & 5587 surf_target%ncs = surf_file%ncs 5588 IF ( ALLOCATED( surf_target%ncsws ) .AND. ALLOCATED( surf_file%ncsws ) ) & 5589 surf_target%ncsws = surf_file%ncsws 5590 IF ( ALLOCATED( surf_target%qrs ) .AND. ALLOCATED( surf_file%qrs ) ) & 5591 surf_target%qrs = surf_file%qrs 5592 IF ( ALLOCATED( surf_target%qrsws ) .AND. ALLOCATED( surf_file%qrsws ) ) & 5593 surf_target%qrsws = surf_file%qrsws 5594 IF ( ALLOCATED( surf_target%nrs ) .AND. ALLOCATED( surf_file%nrs ) ) & 5595 surf_target%nrs = surf_file%nrs 5596 5597 IF ( ALLOCATED( surf_target%nrsws ) .AND. ALLOCATED( surf_file%nrsws ) ) & 5598 surf_target%nrsws = surf_file%nrsws 5599 IF ( ALLOCATED( surf_target%sasws ) .AND. ALLOCATED( surf_file%sasws ) ) & 5600 surf_target%sasws = surf_file%sasws 5601 IF ( ALLOCATED( surf_target%mom_flux_uv ) .AND. ALLOCATED( surf_file%mom_flux_uv ) ) & 5602 surf_target%mom_flux_uv = surf_file%mom_flux_uv 5603 IF ( ALLOCATED( surf_target%mom_flux_w ) .AND. ALLOCATED( surf_file%mom_flux_w ) ) & 5604 surf_target%mom_flux_w = surf_file%mom_flux_w 5605 IF ( ALLOCATED( surf_target%mom_flux_tke ) .AND. ALLOCATED( surf_file%mom_flux_tke ) ) & 5606 surf_target%mom_flux_tke(0:1,:) = surf_file%mom_flux_tke(0:1,:) 5607 5608 5609 END SUBROUTINE restore_surface_elements 5856 5610 5857 5611 END SUBROUTINE surface_rrd_local_mpi … … 5861 5615 5862 5616 5863 !------------------------------------------------------------------------------ !5617 !--------------------------------------------------------------------------------------------------! 5864 5618 ! Description: 5865 5619 ! ------------ 5866 !> Counts the number of surface elements with the same facing, required for 5867 !> re ading and writing restart data.5868 !------------------------------------------------------------------------------ !5869 5870 5871 5872 ! 5873 !-- 5874 5875 5876 5877 ! 5878 !-- 5879 5880 5881 5882 5883 5884 5885 5886 !------------------------------------------------------------------------------ !5620 !> Counts the number of surface elements with the same facing, required for reading and writing 5621 !> restart data. 5622 !--------------------------------------------------------------------------------------------------! 5623 SUBROUTINE surface_last_actions 5624 5625 IMPLICIT NONE 5626 ! 5627 !-- Horizontal surfaces 5628 ns_h_on_file(0) = surf_def_h(0)%ns + surf_lsm_h%ns + surf_usm_h%ns 5629 ns_h_on_file(1) = surf_def_h(1)%ns 5630 ns_h_on_file(2) = surf_def_h(2)%ns 5631 ! 5632 !-- Vertical surfaces 5633 ns_v_on_file(0) = surf_def_v(0)%ns + surf_lsm_v(0)%ns + surf_usm_v(0)%ns 5634 ns_v_on_file(1) = surf_def_v(1)%ns + surf_lsm_v(1)%ns + surf_usm_v(1)%ns 5635 ns_v_on_file(2) = surf_def_v(2)%ns + surf_lsm_v(2)%ns + surf_usm_v(2)%ns 5636 ns_v_on_file(3) = surf_def_v(3)%ns + surf_lsm_v(3)%ns + surf_usm_v(3)%ns 5637 5638 END SUBROUTINE surface_last_actions 5639 5640 !--------------------------------------------------------------------------------------------------! 5887 5641 ! Description: 5888 5642 ! ------------ 5889 5643 !> Routine maps surface data read from file after restart - 1D arrays. 5890 !------------------------------------------------------------------------------! 5891 SUBROUTINE surface_restore_elements_1d( surf_target, surf_file, & 5892 start_index_c, & 5893 start_index_on_file, & 5894 end_index_on_file, & 5895 nxlc, nysc, nxlf, nxrf, nysf, nynf,& 5896 nys_on_file, nyn_on_file, & 5897 nxl_on_file,nxr_on_file ) 5898 5899 IMPLICIT NONE 5900 5901 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 5902 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 5903 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 5904 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 5905 INTEGER(iwp) :: m !< surface-element index on file 5906 INTEGER(iwp) :: mm !< surface-element index on current subdomain 5907 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 5908 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 5909 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 5910 INTEGER(iwp) :: nysc !< index of north boundary on current subdomain 5911 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 5912 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 5913 5914 INTEGER(iwp) :: nxl_on_file !< leftmost index on file 5915 INTEGER(iwp) :: nxr_on_file !< rightmost index on file 5916 INTEGER(iwp) :: nyn_on_file !< northmost index on file 5917 INTEGER(iwp) :: nys_on_file !< southmost index on file 5918 5919 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c 5920 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5921 start_index_on_file !< start index of surface elements on file 5922 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5923 end_index_on_file !< end index of surface elements on file 5924 5925 REAL(wp), DIMENSION(:) :: surf_target !< target surface type 5926 REAL(wp), DIMENSION(:) :: surf_file !< surface type on file 5927 5928 ic = nxlc 5929 DO i = nxlf, nxrf 5930 jc = nysc 5931 DO j = nysf, nynf 5932 5933 mm = start_index_c(jc,ic) 5934 DO m = start_index_on_file(j,i), end_index_on_file(j,i) 5935 surf_target(mm) = surf_file(m) 5936 mm = mm + 1 5937 ENDDO 5938 5939 jc = jc + 1 5644 !--------------------------------------------------------------------------------------------------! 5645 SUBROUTINE surface_restore_elements_1d( surf_target, surf_file, start_index_c, & 5646 start_index_on_file, end_index_on_file, nxlc, nysc, nxlf, & 5647 nxrf, nysf, nynf, nys_on_file, nyn_on_file, nxl_on_file, & 5648 nxr_on_file ) 5649 5650 IMPLICIT NONE 5651 5652 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 5653 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 5654 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 5655 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 5656 INTEGER(iwp) :: m !< surface-element index on file 5657 INTEGER(iwp) :: mm !< surface-element index on current subdomain 5658 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 5659 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 5660 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 5661 INTEGER(iwp) :: nysc !< index of north boundary on current subdomain 5662 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 5663 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 5664 5665 INTEGER(iwp) :: nxl_on_file !< leftmost index on file 5666 INTEGER(iwp) :: nxr_on_file !< rightmost index on file 5667 INTEGER(iwp) :: nyn_on_file !< northmost index on file 5668 INTEGER(iwp) :: nys_on_file !< southmost index on file 5669 5670 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c !< 5671 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: start_index_on_file !< start index of surface 5672 !< elements on file 5673 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: end_index_on_file !< end index of surface 5674 !< elements on file 5675 5676 REAL(wp), DIMENSION(:) :: surf_target !< target surface type 5677 REAL(wp), DIMENSION(:) :: surf_file !< surface type on file 5678 5679 ic = nxlc 5680 DO i = nxlf, nxrf 5681 jc = nysc 5682 DO j = nysf, nynf 5683 mm = start_index_c(jc,ic) 5684 DO m = start_index_on_file(j,i), end_index_on_file(j,i) 5685 surf_target(mm) = surf_file(m) 5686 mm = mm + 1 5940 5687 ENDDO 5941 ic = ic + 15688 jc = jc + 1 5942 5689 ENDDO 5943 5944 5945 END SUBROUTINE surface_restore_elements_1d 5946 5947 !------------------------------------------------------------------------------! 5690 ic = ic + 1 5691 ENDDO 5692 5693 5694 END SUBROUTINE surface_restore_elements_1d 5695 5696 !--------------------------------------------------------------------------------------------------! 5948 5697 ! Description: 5949 5698 ! ------------ 5950 5699 !> Routine maps surface data read from file after restart - 2D arrays 5951 !------------------------------------------------------------------------------! 5952 SUBROUTINE surface_restore_elements_2d( surf_target, surf_file, & 5953 start_index_c, & 5954 start_index_on_file, & 5955 end_index_on_file, & 5956 nxlc, nysc, nxlf, nxrf, nysf, nynf,& 5957 nys_on_file, nyn_on_file, & 5958 nxl_on_file,nxr_on_file ) 5959 5960 IMPLICIT NONE 5961 5962 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 5963 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 5964 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 5965 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 5966 INTEGER(iwp) :: m !< surface-element index on file 5967 INTEGER(iwp) :: mm !< surface-element index on current subdomain 5968 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 5969 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 5970 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 5971 INTEGER(iwp) :: nysc !< index of north boundary on current subdomain 5972 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 5973 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 5974 5975 INTEGER(iwp) :: nxl_on_file !< leftmost index on file 5976 INTEGER(iwp) :: nxr_on_file !< rightmost index on file 5977 INTEGER(iwp) :: nyn_on_file !< northmost index on file 5978 INTEGER(iwp) :: nys_on_file !< southmost index on file 5979 5980 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c !< start index of surface type 5981 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5982 start_index_on_file !< start index of surface elements on file 5983 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: & 5984 end_index_on_file !< end index of surface elements on file 5985 5986 REAL(wp), DIMENSION(:,:) :: surf_target !< target surface type 5987 REAL(wp), DIMENSION(:,:) :: surf_file !< surface type on file 5988 5989 ic = nxlc 5990 DO i = nxlf, nxrf 5991 jc = nysc 5992 DO j = nysf, nynf 5993 mm = start_index_c(jc,ic) 5994 DO m = start_index_on_file(j,i), end_index_on_file(j,i) 5995 surf_target(:,mm) = surf_file(:,m) 5996 mm = mm + 1 5997 ENDDO 5998 5999 jc = jc + 1 5700 !--------------------------------------------------------------------------------------------------! 5701 SUBROUTINE surface_restore_elements_2d( surf_target, surf_file, start_index_c, & 5702 start_index_on_file, end_index_on_file, nxlc, nysc, nxlf, & 5703 nxrf, nysf, nynf, nys_on_file, nyn_on_file, nxl_on_file, & 5704 nxr_on_file ) 5705 5706 IMPLICIT NONE 5707 5708 INTEGER(iwp) :: i !< running index along x-direction, refers to former domain size 5709 INTEGER(iwp) :: ic !< running index along x-direction, refers to current domain size 5710 INTEGER(iwp) :: j !< running index along y-direction, refers to former domain size 5711 INTEGER(iwp) :: jc !< running index along y-direction, refers to former domain size 5712 INTEGER(iwp) :: m !< surface-element index on file 5713 INTEGER(iwp) :: mm !< surface-element index on current subdomain 5714 INTEGER(iwp) :: nxlc !< index of left boundary on current subdomain 5715 INTEGER(iwp) :: nxlf !< index of left boundary on former subdomain 5716 INTEGER(iwp) :: nxrf !< index of right boundary on former subdomain 5717 INTEGER(iwp) :: nysc !< index of north boundary on current subdomain 5718 INTEGER(iwp) :: nynf !< index of north boundary on former subdomain 5719 INTEGER(iwp) :: nysf !< index of south boundary on former subdomain 5720 5721 INTEGER(iwp) :: nxl_on_file !< leftmost index on file 5722 INTEGER(iwp) :: nxr_on_file !< rightmost index on file 5723 INTEGER(iwp) :: nyn_on_file !< northmost index on file 5724 INTEGER(iwp) :: nys_on_file !< southmost index on file 5725 5726 INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) :: start_index_c !< start index of surface type 5727 5728 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: start_index_on_file !< start index of surface 5729 !< elements on file 5730 INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) :: end_index_on_file !< end index of surface 5731 !< elements on file 5732 5733 REAL(wp), DIMENSION(:,:) :: surf_target !< target surface type 5734 REAL(wp), DIMENSION(:,:) :: surf_file !< surface type on file 5735 5736 ic = nxlc 5737 DO i = nxlf, nxrf 5738 jc = nysc 5739 DO j = nysf, nynf 5740 mm = start_index_c(jc,ic) 5741 DO m = start_index_on_file(j,i), end_index_on_file(j,i) 5742 surf_target(:,mm) = surf_file(:,m) 5743 mm = mm + 1 6000 5744 ENDDO 6001 ic = ic + 15745 jc = jc + 1 6002 5746 ENDDO 6003 6004 END SUBROUTINE surface_restore_elements_2d 5747 ic = ic + 1 5748 ENDDO 5749 5750 END SUBROUTINE surface_restore_elements_2d 6005 5751 6006 5752
Note: See TracChangeset
for help on using the changeset viewer.
