Changeset 3542 for palm/trunk
- Timestamp:
- Nov 20, 2018 5:04:13 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 6 edited
-
chemistry_model_mod.f90 (modified) (5 diffs)
-
exchange_horiz_2d.f90 (modified) (4 diffs)
-
init_pegrid.f90 (modified) (3 diffs)
-
lpm_exchange_horiz.f90 (modified) (1 diff)
-
modules.f90 (modified) (2 diffs)
-
netcdf_data_input_mod.f90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chemistry_model_mod.f90
r3524 r3542 22 22 ! Current revisions: 23 23 ! ----------------- 24 ! 24 ! Remove tabs 25 25 ! 26 26 ! Former revisions: … … 295 295 ! DEPAC landuse classes as defined in LOTOS-EUROS model v2.1 296 296 ! 297 INTEGER(iwp) :: ilu_grass 298 INTEGER(iwp) :: ilu_arable 297 INTEGER(iwp) :: ilu_grass = 1 298 INTEGER(iwp) :: ilu_arable = 2 299 299 INTEGER(iwp) :: ilu_permanent_crops = 3 300 300 INTEGER(iwp) :: ilu_coniferous_forest = 4 301 301 INTEGER(iwp) :: ilu_deciduous_forest = 5 302 INTEGER(iwp) :: ilu_water_sea 303 INTEGER(iwp) :: ilu_urban 302 INTEGER(iwp) :: ilu_water_sea = 6 303 INTEGER(iwp) :: ilu_urban = 7 304 304 INTEGER(iwp) :: ilu_other = 8 305 305 INTEGER(iwp) :: ilu_desert = 9 … … 313 313 !-------------------------------------------------------------------------- 314 314 ! NH3/SO2 ratio regimes: 315 INTEGER, PARAMETER :: iratns_low 316 INTEGER, PARAMETER :: iratns_high 315 INTEGER, PARAMETER :: iratns_low = 1 ! low ratio NH3/SO2 316 INTEGER, PARAMETER :: iratns_high = 2 ! high ratio NH3/SO2 317 317 INTEGER, PARAMETER :: iratns_very_low = 3 ! very low ratio NH3/SO2 318 318 ! Default: … … 4209 4209 INTEGER(iwp) , INTENT(in) :: day_of_year ! day of year, 1 ... 365 (366) 4210 4210 REAL(kind=wp) , INTENT(in) :: lat ! latitude Northern hemisphere (degrees) (DEPAC cannot be used for S. hemisphere) 4211 REAL(kind=wp) , INTENT(in) :: t 4211 REAL(kind=wp) , INTENT(in) :: t ! temperature (C) 4212 4212 ! NB discussion issue is temp T_2m or T_surf or T_leaf? 4213 4213 REAL(kind=wp) , INTENT(in) :: ust ! friction velocity (m/s) … … 4615 4615 4616 4616 ! input/output variables: 4617 INTEGER(iwp), INTENT(in) :: icmp 4618 CHARACTER(len=*), INTENT(in) :: compnam 4619 INTEGER(iwp), INTENT(in) :: lu 4617 INTEGER(iwp), INTENT(in) :: icmp ! component index 4618 CHARACTER(len=*), INTENT(in) :: compnam ! component name 4619 INTEGER(iwp), INTENT(in) :: lu ! land use type , lu = 1,...,nlu 4620 4620 LOGICAL, INTENT(in) :: LAI_present 4621 REAL(kind=wp), INTENT(in) :: lai 4622 REAL(kind=wp), INTENT(in) :: glrad 4623 REAL(kind=wp), INTENT(in) :: sinphi 4624 REAL(kind=wp), INTENT(in) :: t 4625 REAL(kind=wp), INTENT(in) :: rh 4626 REAL(kind=wp), INTENT(in) :: diffc 4627 REAL(kind=wp), INTENT(out):: gstom 4628 REAL(kind=wp), OPTIONAL,INTENT(in) :: p 4621 REAL(kind=wp), INTENT(in) :: lai ! one-sided leaf area index 4622 REAL(kind=wp), INTENT(in) :: glrad ! global radiation (W/m2) 4623 REAL(kind=wp), INTENT(in) :: sinphi ! sin of solar elevation angle 4624 REAL(kind=wp), INTENT(in) :: t ! temperature (C) 4625 REAL(kind=wp), INTENT(in) :: rh ! relative humidity (%) 4626 REAL(kind=wp), INTENT(in) :: diffc ! diffusion coefficient of the gas involved 4627 REAL(kind=wp), INTENT(out):: gstom ! stomatal conductance (m/s) 4628 REAL(kind=wp), OPTIONAL,INTENT(in) :: p ! pressure (Pa) 4629 4629 4630 4630 -
palm/trunk/SOURCE/exchange_horiz_2d.f90
r3183 r3542 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! - New routine for exchange of 8-bit integer arrays 23 ! - Set Neumann conditions also at radiation boundary 23 24 ! 24 25 ! Former revisions: … … 213 214 214 215 215 216 216 !------------------------------------------------------------------------------! 217 217 ! Description: 218 218 ! ------------ 219 219 !> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic 220 !> boundary conditions, respectively, for 2D integer arrays. 221 !------------------------------------------------------------------------------! 222 223 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local ) 220 !> boundary conditions, respectively, for 2D 8-bit integer arrays. 221 !------------------------------------------------------------------------------! 222 SUBROUTINE exchange_horiz_2d_byte( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local ) 224 223 225 224 226 225 USE control_parameters, & 227 226 ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, & 228 bc_dirichlet_s, bc_lr_cyc, bc_ns_cyc, bc_radiation_l, & 227 bc_dirichlet_s, bc_radiation_l, bc_radiation_n, bc_radiation_r, & 228 bc_radiation_s, bc_lr_cyc, bc_ns_cyc, bc_radiation_l, & 229 229 bc_radiation_n, bc_radiation_r, bc_radiation_s, grid_level 230 230 … … 245 245 INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged 246 246 247 INTEGER(KIND=1), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, & 248 nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array 249 250 CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'start' ) 251 252 #if defined( __parallel ) 253 254 ! 255 !-- Exchange of lateral boundary values for parallel computers 256 IF ( pdims(1) == 1 ) THEN 257 258 ! 259 !-- One-dimensional decomposition along y, boundary values can be exchanged 260 !-- within the PE memory 261 ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l) 262 ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1) 263 264 ELSE 265 ! 266 !-- Send left boundary, receive right one 267 CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxl_l), 1, & 268 type_y_byte, pleft, 0, & 269 ar(nys_l-nbgp_local,nxr_l+1), 1, & 270 type_y_byte, pright, 0, & 271 comm2d, status, ierr ) 272 ! 273 !-- Send right boundary, receive left one 274 CALL MPI_SENDRECV( ar(nys_l-nbgp_local,nxr_l+1-nbgp_local), 1, & 275 type_y_byte, pright, 1, & 276 ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, & 277 type_y_byte, pleft, 1, & 278 comm2d, status, ierr ) 279 280 ENDIF 281 282 IF ( pdims(2) == 1 ) THEN 283 ! 284 !-- One-dimensional decomposition along x, boundary values can be exchanged 285 !-- within the PE memory 286 ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:) 287 ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:) 288 289 290 ELSE 291 ! 292 !-- Send front boundary, receive rear one 293 CALL MPI_SENDRECV( ar(nys_l,nxl_l-nbgp_local), 1, & 294 type_x_byte, psouth, 0, & 295 ar(nyn_l+1,nxl_l-nbgp_local), 1, & 296 type_x_byte, pnorth, 0, & 297 comm2d, status, ierr ) 298 299 ! 300 !-- Send rear boundary, receive front one 301 CALL MPI_SENDRECV( ar(nyn_l+1-nbgp_local,nxl_l-nbgp_local), 1, & 302 type_x_byte, pnorth, 1, & 303 ar(nys_l-nbgp_local,nxl_l-nbgp_local), 1, & 304 type_x_byte, psouth, 1, & 305 comm2d, status, ierr ) 306 307 ENDIF 308 309 #else 310 311 ! 312 !-- Lateral boundary conditions in the non-parallel case 313 IF ( bc_lr_cyc ) THEN 314 ar(:,nxl_l-nbgp_local:nxl_l-1) = ar(:,nxr_l-nbgp_local+1:nxr_l) 315 ar(:,nxr_l+1:nxr_l+nbgp_local) = ar(:,nxl_l:nxl_l+nbgp_local-1) 316 ENDIF 317 318 IF ( bc_ns_cyc ) THEN 319 ar(nys_l-nbgp_local:nys_l-1,:) = ar(nyn_l+1-nbgp_local:nyn_l,:) 320 ar(nyn_l+1:nyn_l+nbgp_local,:) = ar(nys_l:nys_l-1+nbgp_local,:) 321 ENDIF 322 323 #endif 324 ! 325 !-- Neumann-conditions at inflow/outflow/nested boundaries 326 IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN 327 DO i = nbgp_local, 1, -1 328 ar(:,nxl_l-i) = ar(:,nxl_l) 329 ENDDO 330 ENDIF 331 IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN 332 DO i = 1, nbgp_local 333 ar(:,nxr_l+i) = ar(:,nxr_l) 334 ENDDO 335 ENDIF 336 IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN 337 DO i = nbgp_local, 1, -1 338 ar(nys_l-i,:) = ar(nys_l,:) 339 ENDDO 340 ENDIF 341 IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN 342 DO i = 1, nbgp_local 343 ar(nyn_l+i,:) = ar(nyn_l,:) 344 ENDDO 345 ENDIF 346 347 CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' ) 348 349 END SUBROUTINE exchange_horiz_2d_byte 350 351 352 !------------------------------------------------------------------------------! 353 ! Description: 354 ! ------------ 355 !> Exchange of lateral (ghost) boundaries (parallel computers) and cyclic 356 !> boundary conditions, respectively, for 2D 32-bit integer arrays. 357 !------------------------------------------------------------------------------! 358 SUBROUTINE exchange_horiz_2d_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nbgp_local ) 359 360 361 USE control_parameters, & 362 ONLY: bc_dirichlet_l, bc_dirichlet_n, bc_dirichlet_r, & 363 bc_dirichlet_s, bc_radiation_l, bc_radiation_n, bc_radiation_r, & 364 bc_radiation_s, bc_lr_cyc, bc_ns_cyc, bc_radiation_l, & 365 bc_radiation_n, bc_radiation_r, bc_radiation_s, grid_level 366 367 USE cpulog, & 368 ONLY: cpu_log, log_point_s 369 370 USE kinds 371 372 USE pegrid 373 374 IMPLICIT NONE 375 376 INTEGER(iwp) :: i !< dummy index to zero-gradient conditions at in/outflow boundaries 377 INTEGER(iwp) :: nxl_l !< local index bound at current grid level, left side 378 INTEGER(iwp) :: nxr_l !< local index bound at current grid level, right side 379 INTEGER(iwp) :: nyn_l !< local index bound at current grid level, north side 380 INTEGER(iwp) :: nys_l !< local index bound at current grid level, south side 381 INTEGER(iwp) :: nbgp_local !< number of ghost layers to be exchanged 382 247 383 INTEGER(iwp), DIMENSION(nys_l-nbgp_local:nyn_l+nbgp_local, & 248 384 nxl_l-nbgp_local:nxr_l+nbgp_local) :: ar !< treated array … … 324 460 ! 325 461 !-- Neumann-conditions at inflow/outflow/nested boundaries 326 IF ( bc_dirichlet_l ) THEN462 IF ( bc_dirichlet_l .OR. bc_radiation_l ) THEN 327 463 DO i = nbgp_local, 1, -1 328 464 ar(:,nxl_l-i) = ar(:,nxl_l) 329 465 ENDDO 330 466 ENDIF 331 IF ( bc_dirichlet_r ) THEN467 IF ( bc_dirichlet_r .OR. bc_radiation_r ) THEN 332 468 DO i = 1, nbgp_local 333 469 ar(:,nxr_l+i) = ar(:,nxr_l) 334 470 ENDDO 335 471 ENDIF 336 IF ( bc_dirichlet_s ) THEN472 IF ( bc_dirichlet_s .OR. bc_radiation_s ) THEN 337 473 DO i = nbgp_local, 1, -1 338 474 ar(nys_l-i,:) = ar(nys_l,:) 339 475 ENDDO 340 476 ENDIF 341 IF ( bc_dirichlet_n ) THEN477 IF ( bc_dirichlet_n .OR. bc_radiation_n ) THEN 342 478 DO i = 1, nbgp_local 343 479 ar(nyn_l+i,:) = ar(nyn_l,:) -
palm/trunk/SOURCE/init_pegrid.f90
r3347 r3542 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! Introduce new MPI-datatype for ghostpoint exchange of 2D 8-bit Integer arrays 23 23 ! 24 24 ! Former revisions: … … 1110 1110 ! 1111 1111 !-- Define new MPI derived datatypes for the exchange of ghost points in 1112 !-- x- and y-direction for 2D-INTEGER arrays (line) - on normal grid 1112 !-- x- and y-direction for 2D-INTEGER arrays (line) - on normal grid. 1113 !-- Define types for 32-bit and 8-bit Integer. The 8-bit Integer are only 1114 !-- required on normal grid, while 32-bit Integer may be also required on 1115 !-- coarser grid level in case of multigrid solver. 1116 ! 1117 !-- 8-bit Integer 1118 CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp, ngp_y, MPI_BYTE, & 1119 type_x_byte, ierr ) 1120 CALL MPI_TYPE_COMMIT( type_x_byte, ierr ) 1121 1122 CALL MPI_TYPE_VECTOR( nbgp, ngp_y, ngp_y, MPI_BYTE, & 1123 type_y_byte, ierr ) 1124 CALL MPI_TYPE_COMMIT( type_y_byte, ierr ) 1125 ! 1126 !-- 32-bit Integer 1113 1127 ALLOCATE( type_x_int(0:maximum_grid_level), & 1114 1128 type_y_int(0:maximum_grid_level) ) 1115 1129 1116 1130 CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp, ngp_y, MPI_INTEGER, & 1117 1131 type_x_int(0), ierr ) … … 1211 1225 1212 1226 !-- For 2D-exchange of INTEGER arrays on coarser grid level, where 2 ghost 1213 !-- points need to be exchanged. 1214 CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+5, 2, nyn_l-nys_l+5, MPI_INTEGER, 1227 !-- points need to be exchanged. Only required for 32-bit Integer arrays. 1228 CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+5, 2, nyn_l-nys_l+5, MPI_INTEGER, & 1215 1229 type_x_int(i), ierr ) 1216 1230 CALL MPI_TYPE_COMMIT( type_x_int(i), ierr ) 1217 1231 1218 1232 1219 CALL MPI_TYPE_VECTOR( 2, nyn_l-nys_l+5, nyn_l-nys_l+5, MPI_INTEGER, 1233 CALL MPI_TYPE_VECTOR( 2, nyn_l-nys_l+5, nyn_l-nys_l+5, MPI_INTEGER, & 1220 1234 type_y_int(i), ierr ) 1221 1235 CALL MPI_TYPE_COMMIT( type_y_int(i), ierr ) -
palm/trunk/SOURCE/lpm_exchange_horiz.f90
r3065 r3542 152 152 ! Description: 153 153 ! ------------ 154 ! Exchange of particles between the subdomains.154 !> Exchange of particles between the subdomains. 155 155 !------------------------------------------------------------------------------! 156 156 MODULE lpm_exchange_horiz_mod -
palm/trunk/SOURCE/modules.f90
r3529 r3542 20 20 ! Current revisions: 21 21 ! ------------------ 22 ! 22 ! +type_x_byte, type_y_byte 23 23 ! 24 24 ! Former revisions: … … 2024 2024 INTEGER(iwp), DIMENSION(MPI_STATUS_SIZE,100) :: wait_stat !< MPI status variable used in various MPI calls 2025 2025 2026 INTEGER(iwp) :: type_x_byte !< derived MPI datatype for 2-D 8-bit integer ghost-point exchange - north / south 2027 INTEGER(iwp) :: type_y_byte !< derived MPI datatype for 2-D integer ghost-point exchange - left / right 2028 2026 2029 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ngp_xz !< number of ghost points in xz-plane on different multigrid level 2027 2030 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: ngp_xz_int !< number of ghost points in xz-plane on different multigrid level -
palm/trunk/SOURCE/netcdf_data_input_mod.f90
r3529 r3542 20 20 ! Current revisions: 21 21 ! ----------------- 22 ! 22 ! Revise ghost point exchange and resizing of input variables 23 23 ! 24 24 ! Former revisions: … … 267 267 ONLY: cpu_log, log_point_s 268 268 269 USE indices, & 270 ONLY: nbgp 271 269 272 USE kinds 270 273 … … 1543 1546 1544 1547 USE indices, & 1545 ONLY: nbgp, nx, nxl, nx lg, nxr, nxrg, ny, nyn, nyng, nys, nysg1548 ONLY: nbgp, nx, nxl, nxr,ny, nyn, nys 1546 1549 1547 1550 … … 1555 1558 INTEGER(iwp) :: num_vars !< number of variables in input file 1556 1559 INTEGER(iwp) :: nz_soil !< number of soil layers in file 1557 1558 INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg) :: var_exchange_int !< dummy variables used to exchange 32-bit Integer arrays1559 INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE :: var_dum_int_3d !< dummy variables used to exchange real arrays1560 1561 REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) :: var_exchange_real !< dummy variables used to exchange real arrays1562 1563 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var_dum_real_3d !< dummy variables used to exchange real arrays1564 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var_dum_real_4d !< dummy variables used to exchange real arrays1565 1560 1566 1561 ! … … 1674 1669 !-- applied. This case, no one of the following variables is used anyway. 1675 1670 IF ( .NOT. land_surface .AND. .NOT. urban_surface ) RETURN 1676 !1677 !-- Initialize dummy arrays used for ghost-point exchange1678 var_exchange_int = 01679 var_exchange_real = 0.0_wp1680 1671 1681 1672 #if defined ( __netcdf ) … … 2125 2116 CALL cpu_log( log_point_s(82), 'NetCDF input', 'stop' ) 2126 2117 ! 2127 !-- Exchange 1 ghost points for surface variables. Please note, ghost point 2128 !-- exchange for 3D parameter lists should be revised by using additional 2129 !-- MPI datatypes or rewriting exchange_horiz. 2130 !-- Moreover, varialbes will be resized in the following, including ghost 2131 !-- points. 2132 !-- Start with 2D Integer variables. Please note, for 8-bit integer 2133 !-- variables must be swapt to 32-bit integer before calling exchange_horiz. 2118 !-- Exchange ghost points for surface variables. Therefore, resize 2119 !-- variables. 2134 2120 IF ( albedo_type_f%from_file ) THEN 2135 var_exchange_int = INT( albedo_type_f%fill, KIND = 1 ) 2136 var_exchange_int(nys:nyn,nxl:nxr) = & 2137 INT( albedo_type_f%var(nys:nyn,nxl:nxr), KIND = 4 ) 2138 CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp ) 2139 DEALLOCATE( albedo_type_f%var ) 2140 ALLOCATE( albedo_type_f%var(nysg:nyng,nxlg:nxrg) ) 2141 albedo_type_f%var = INT( var_exchange_int, KIND = 1 ) 2121 CALL resize_array_2d_int8( albedo_type_f%var, nys, nyn, nxl, nxr ) 2122 CALL exchange_horiz_2d_byte( albedo_type_f%var, nys, nyn, nxl, nxr, & 2123 nbgp ) 2142 2124 ENDIF 2143 2125 IF ( pavement_type_f%from_file ) THEN 2144 var_exchange_int = INT( pavement_type_f%fill, KIND = 1 ) 2145 var_exchange_int(nys:nyn,nxl:nxr) = & 2146 INT( pavement_type_f%var(nys:nyn,nxl:nxr), KIND = 4 ) 2147 CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp ) 2148 DEALLOCATE( pavement_type_f%var ) 2149 ALLOCATE( pavement_type_f%var(nysg:nyng,nxlg:nxrg) ) 2150 pavement_type_f%var = INT( var_exchange_int, KIND = 1 ) 2126 CALL resize_array_2d_int8( pavement_type_f%var, nys, nyn, nxl, nxr ) 2127 CALL exchange_horiz_2d_byte( pavement_type_f%var, nys, nyn, nxl, nxr,& 2128 nbgp ) 2151 2129 ENDIF 2152 2130 IF ( soil_type_f%from_file .AND. ALLOCATED( soil_type_f%var_2d ) ) THEN 2153 var_exchange_int = INT( soil_type_f%fill, KIND = 1 ) 2154 var_exchange_int(nys:nyn,nxl:nxr) = & 2155 INT( soil_type_f%var_2d(nys:nyn,nxl:nxr), KIND = 4 ) 2156 CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp ) 2157 DEALLOCATE( soil_type_f%var_2d ) 2158 ALLOCATE( soil_type_f%var_2d(nysg:nyng,nxlg:nxrg) ) 2159 soil_type_f%var_2d = INT( var_exchange_int, KIND = 1 ) 2131 CALL resize_array_2d_int8( soil_type_f%var_2d, nys, nyn, nxl, nxr ) 2132 CALL exchange_horiz_2d_byte( soil_type_f%var_2d, nys, nyn, nxl, nxr, & 2133 nbgp ) 2160 2134 ENDIF 2161 2135 IF ( vegetation_type_f%from_file ) THEN 2162 var_exchange_int = INT( vegetation_type_f%fill, KIND = 1 ) 2163 var_exchange_int(nys:nyn,nxl:nxr) = & 2164 INT( vegetation_type_f%var(nys:nyn,nxl:nxr), KIND = 4 ) 2165 CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp ) 2166 DEALLOCATE( vegetation_type_f%var ) 2167 ALLOCATE( vegetation_type_f%var(nysg:nyng,nxlg:nxrg) ) 2168 vegetation_type_f%var = INT( var_exchange_int, KIND = 1 ) 2136 CALL resize_array_2d_int8( vegetation_type_f%var, nys, nyn, nxl, nxr ) 2137 CALL exchange_horiz_2d_byte( vegetation_type_f%var, nys, nyn, nxl, & 2138 nxr, nbgp ) 2169 2139 ENDIF 2170 2140 IF ( water_type_f%from_file ) THEN 2171 var_exchange_int = INT( water_type_f%fill, KIND = 1 ) 2172 var_exchange_int(nys:nyn,nxl:nxr) = & 2173 INT( water_type_f%var(nys:nyn,nxl:nxr), KIND = 4 ) 2174 CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp ) 2175 DEALLOCATE( water_type_f%var ) 2176 ALLOCATE( water_type_f%var(nysg:nyng,nxlg:nxrg) ) 2177 water_type_f%var = INT( var_exchange_int, KIND = 1 ) 2178 ENDIF 2179 ! 2180 !-- Exchange 1 ghost point for 3/4-D variables. For the sake of simplicity, 2181 !-- loop further dimensions to use 2D exchange routines. 2182 !-- This should be revised later by introducing new MPI datatypes. 2141 CALL resize_array_2d_int8( water_type_f%var, nys, nyn, nxl, nxr ) 2142 CALL exchange_horiz_2d_byte( water_type_f%var, nys, nyn, nxl, nxr, & 2143 nbgp ) 2144 ENDIF 2145 ! 2146 !-- Exchange ghost points for 3/4-D variables. For the sake of simplicity, 2147 !-- loop further dimensions to use 2D exchange routines. Unfortunately this 2148 !-- is necessary, else new MPI-data types need to be introduced just for 2149 !-- 2 variables. 2183 2150 IF ( soil_type_f%from_file .AND. ALLOCATED( soil_type_f%var_3d ) ) & 2184 2151 THEN 2185 ALLOCATE( var_dum_int_3d(0:nz_soil,nys:nyn,nxl:nxr) ) 2186 var_dum_int_3d = soil_type_f%var_3d 2187 DEALLOCATE( soil_type_f%var_3d ) 2188 ALLOCATE( soil_type_f%var_3d(0:nz_soil,nysg:nyng,nxlg:nxrg) ) 2189 soil_type_f%var_3d = soil_type_f%fill 2190 2152 CALL resize_array_3d_int8( soil_type_f%var_3d, 0, nz_soil, & 2153 nys, nyn, nxl, nxr ) 2191 2154 DO k = 0, nz_soil 2192 var_exchange_int(nys:nyn,nxl:nxr) = var_dum_int_3d(k,nys:nyn,nxl:nxr) 2193 CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp ) 2194 soil_type_f%var_3d(k,:,:) = INT( var_exchange_int(:,:), KIND = 1 ) 2155 CALL exchange_horiz_2d_int( & 2156 soil_type_f%var_3d(k,:,:), nys, nyn, nxl, nxr, nbgp ) 2195 2157 ENDDO 2196 DEALLOCATE( var_dum_int_3d )2197 2158 ENDIF 2198 2159 2199 2160 IF ( surface_fraction_f%from_file ) THEN 2200 ALLOCATE( var_dum_real_3d(0:surface_fraction_f%nf-1,nys:nyn,nxl:nxr) ) 2201 var_dum_real_3d = surface_fraction_f%frac 2202 DEALLOCATE( surface_fraction_f%frac ) 2203 ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1, & 2204 nysg:nyng,nxlg:nxrg) ) 2205 surface_fraction_f%frac = surface_fraction_f%fill 2206 2161 CALL resize_array_3d_real( surface_fraction_f%frac, & 2162 0, surface_fraction_f%nf-1, & 2163 nys, nyn, nxl, nxr ) 2207 2164 DO k = 0, surface_fraction_f%nf-1 2208 var_exchange_real(nys:nyn,nxl:nxr) = var_dum_real_3d(k,nys:nyn,nxl:nxr) 2209 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2210 surface_fraction_f%frac(k,:,:) = var_exchange_real(:,:) 2165 CALL exchange_horiz_2d( surface_fraction_f%frac(k,:,:), nbgp ) 2211 2166 ENDDO 2212 DEALLOCATE( var_dum_real_3d ) 2213 ENDIF 2214 2215 IF ( building_pars_f%from_file ) THEN 2216 ALLOCATE( var_dum_real_3d(0:building_pars_f%np-1,nys:nyn,nxl:nxr) ) 2217 var_dum_real_3d = building_pars_f%pars_xy 2218 DEALLOCATE( building_pars_f%pars_xy ) 2219 ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1, & 2220 nysg:nyng,nxlg:nxrg) ) 2221 building_pars_f%pars_xy = building_pars_f%fill 2167 ENDIF 2168 2169 IF ( building_pars_f%from_file ) THEN 2170 CALL resize_array_3d_real( building_pars_f%pars_xy, & 2171 0, building_pars_f%np-1, & 2172 nys, nyn, nxl, nxr ) 2222 2173 DO k = 0, building_pars_f%np-1 2223 var_exchange_real(nys:nyn,nxl:nxr) = & 2224 var_dum_real_3d(k,nys:nyn,nxl:nxr) 2225 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2226 building_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:) 2174 CALL exchange_horiz_2d( building_pars_f%pars_xy(k,:,:), nbgp ) 2227 2175 ENDDO 2228 DEALLOCATE( var_dum_real_3d ) 2229 ENDIF 2230 2231 IF ( albedo_pars_f%from_file ) THEN 2232 ALLOCATE( var_dum_real_3d(0:albedo_pars_f%np-1,nys:nyn,nxl:nxr) ) 2233 var_dum_real_3d = albedo_pars_f%pars_xy 2234 DEALLOCATE( albedo_pars_f%pars_xy ) 2235 ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1, & 2236 nysg:nyng,nxlg:nxrg) ) 2237 albedo_pars_f%pars_xy = albedo_pars_f%fill 2176 ENDIF 2177 2178 IF ( albedo_pars_f%from_file ) THEN 2179 CALL resize_array_3d_real( albedo_pars_f%pars_xy, & 2180 0, albedo_pars_f%np-1, & 2181 nys, nyn, nxl, nxr ) 2238 2182 DO k = 0, albedo_pars_f%np-1 2239 var_exchange_real(nys:nyn,nxl:nxr) = & 2240 var_dum_real_3d(k,nys:nyn,nxl:nxr) 2241 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2242 albedo_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:) 2183 CALL exchange_horiz_2d( albedo_pars_f%pars_xy(k,:,:), nbgp ) 2243 2184 ENDDO 2244 DEALLOCATE( var_dum_real_3d ) 2245 ENDIF 2246 2247 IF ( pavement_pars_f%from_file ) THEN 2248 ALLOCATE( var_dum_real_3d(0:pavement_pars_f%np-1,nys:nyn,nxl:nxr) ) 2249 var_dum_real_3d = pavement_pars_f%pars_xy 2250 DEALLOCATE( pavement_pars_f%pars_xy ) 2251 ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1, & 2252 nysg:nyng,nxlg:nxrg) ) 2253 pavement_pars_f%pars_xy = pavement_pars_f%fill 2185 ENDIF 2186 2187 IF ( pavement_pars_f%from_file ) THEN 2188 CALL resize_array_3d_real( pavement_pars_f%pars_xy, & 2189 0, pavement_pars_f%np-1, & 2190 nys, nyn, nxl, nxr ) 2254 2191 DO k = 0, pavement_pars_f%np-1 2255 var_exchange_real(nys:nyn,nxl:nxr) = & 2256 var_dum_real_3d(k,nys:nyn,nxl:nxr) 2257 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2258 pavement_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:) 2192 CALL exchange_horiz_2d( pavement_pars_f%pars_xy(k,:,:), nbgp ) 2259 2193 ENDDO 2260 DEALLOCATE( var_dum_real_3d )2261 2194 ENDIF 2262 2195 2263 2196 IF ( vegetation_pars_f%from_file ) THEN 2264 ALLOCATE( var_dum_real_3d(0:vegetation_pars_f%np-1,nys:nyn,nxl:nxr) ) 2265 var_dum_real_3d = vegetation_pars_f%pars_xy 2266 DEALLOCATE( vegetation_pars_f%pars_xy ) 2267 ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1, & 2268 nysg:nyng,nxlg:nxrg) ) 2269 vegetation_pars_f%pars_xy = vegetation_pars_f%fill 2197 CALL resize_array_3d_real( vegetation_pars_f%pars_xy, & 2198 0, vegetation_pars_f%np-1, & 2199 nys, nyn, nxl, nxr ) 2270 2200 DO k = 0, vegetation_pars_f%np-1 2271 var_exchange_real(nys:nyn,nxl:nxr) = & 2272 var_dum_real_3d(k,nys:nyn,nxl:nxr) 2273 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2274 vegetation_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:) 2201 CALL exchange_horiz_2d( vegetation_pars_f%pars_xy(k,:,:), nbgp ) 2275 2202 ENDDO 2276 DEALLOCATE( var_dum_real_3d )2277 2203 ENDIF 2278 2204 2279 2205 IF ( water_pars_f%from_file ) THEN 2280 ALLOCATE( var_dum_real_3d(0:water_pars_f%np-1,nys:nyn,nxl:nxr) ) 2281 var_dum_real_3d = water_pars_f%pars_xy 2282 DEALLOCATE( water_pars_f%pars_xy ) 2283 ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1, & 2284 nysg:nyng,nxlg:nxrg) ) 2285 water_pars_f%pars_xy = water_pars_f%fill 2206 CALL resize_array_3d_real( water_pars_f%pars_xy, & 2207 0, water_pars_f%np-1, & 2208 nys, nyn, nxl, nxr ) 2286 2209 DO k = 0, water_pars_f%np-1 2287 var_exchange_real(nys:nyn,nxl:nxr) = & 2288 var_dum_real_3d(k,nys:nyn,nxl:nxr) 2289 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2290 water_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:) 2210 CALL exchange_horiz_2d( water_pars_f%pars_xy(k,:,:), nbgp ) 2291 2211 ENDDO 2292 DEALLOCATE( var_dum_real_3d )2293 2212 ENDIF 2294 2213 2295 2214 IF ( root_area_density_lsm_f%from_file ) THEN 2296 ALLOCATE( var_dum_real_3d(0:root_area_density_lsm_f%nz-1,nys:nyn,nxl:nxr) ) 2297 var_dum_real_3d = root_area_density_lsm_f%var 2298 DEALLOCATE( root_area_density_lsm_f%var ) 2299 ALLOCATE( root_area_density_lsm_f%var(0:root_area_density_lsm_f%nz-1,& 2300 nysg:nyng,nxlg:nxrg) ) 2301 root_area_density_lsm_f%var = root_area_density_lsm_f%fill 2302 2215 CALL resize_array_3d_real( root_area_density_lsm_f%var, & 2216 0, root_area_density_lsm_f%nz-1, & 2217 nys, nyn, nxl, nxr ) 2303 2218 DO k = 0, root_area_density_lsm_f%nz-1 2304 var_exchange_real(nys:nyn,nxl:nxr) = & 2305 var_dum_real_3d(k,nys:nyn,nxl:nxr) 2306 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2307 root_area_density_lsm_f%var(k,:,:) = var_exchange_real(:,:) 2219 CALL exchange_horiz_2d( root_area_density_lsm_f%var(k,:,:), nbgp ) 2308 2220 ENDDO 2309 DEALLOCATE( var_dum_real_3d )2310 2221 ENDIF 2311 2222 2312 2223 IF ( soil_pars_f%from_file ) THEN 2313 2224 IF ( soil_pars_f%lod == 1 ) THEN 2314 2315 ALLOCATE( var_dum_real_3d(0:soil_pars_f%np-1,nys:nyn,nxl:nxr) ) 2316 var_dum_real_3d = soil_pars_f%pars_xy 2317 DEALLOCATE( soil_pars_f%pars_xy ) 2318 ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1, & 2319 nysg:nyng,nxlg:nxrg) ) 2320 soil_pars_f%pars_xy = soil_pars_f%fill 2321 2225 2226 CALL resize_array_3d_real( soil_pars_f%pars_xy, & 2227 0, soil_pars_f%np-1, & 2228 nys, nyn, nxl, nxr ) 2322 2229 DO k = 0, soil_pars_f%np-1 2323 var_exchange_real(nys:nyn,nxl:nxr) = & 2324 var_dum_real_3d(k,nys:nyn,nxl:nxr) 2325 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2326 soil_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:) 2230 CALL exchange_horiz_2d( soil_pars_f%pars_xy(k,:,:), nbgp ) 2327 2231 ENDDO 2328 DEALLOCATE( var_dum_real_3d )2232 2329 2233 ELSEIF ( soil_pars_f%lod == 2 ) THEN 2330 ALLOCATE( var_dum_real_4d(0:soil_pars_f%np-1, & 2331 0:soil_pars_f%nz-1, & 2332 nys:nyn,nxl:nxr) ) 2333 var_dum_real_4d = soil_pars_f%pars_xyz 2334 DEALLOCATE( soil_pars_f%pars_xyz ) 2335 ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1, & 2336 0:soil_pars_f%nz-1, & 2337 nysg:nyng,nxlg:nxrg) ) 2338 soil_pars_f%pars_xyz = soil_pars_f%fill 2234 CALL resize_array_4d_real( soil_pars_f%pars_xyz, & 2235 0, soil_pars_f%np-1, & 2236 0, soil_pars_f%nz-1, & 2237 nys, nyn, nxl, nxr ) 2339 2238 2340 2239 DO k2 = 0, soil_pars_f%nz-1 2341 2240 DO k = 0, soil_pars_f%np-1 2342 var_exchange_real(nys:nyn,nxl:nxr) = & 2343 var_dum_real_4d(k,k2,nys:nyn,nxl:nxr) 2344 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2345 2346 soil_pars_f%pars_xyz(k,k2,:,:) = var_exchange_real(:,:) 2241 CALL exchange_horiz_2d( soil_pars_f%pars_xyz(k,k2,:,:), & 2242 nbgp ) 2347 2243 ENDDO 2348 2244 ENDDO 2349 DEALLOCATE( var_dum_real_4d ) 2350 ENDIF 2351 ENDIF 2352 2353 IF ( pavement_subsurface_pars_f%from_file ) THEN 2354 ALLOCATE( var_dum_real_4d(0:pavement_subsurface_pars_f%np-1, & 2355 0:pavement_subsurface_pars_f%nz-1, & 2356 nys:nyn,nxl:nxr) ) 2357 var_dum_real_4d = pavement_subsurface_pars_f%pars_xyz 2358 DEALLOCATE( pavement_subsurface_pars_f%pars_xyz ) 2359 ALLOCATE( pavement_subsurface_pars_f%pars_xyz & 2360 (0:pavement_subsurface_pars_f%np-1, & 2361 0:pavement_subsurface_pars_f%nz-1, & 2362 nysg:nyng,nxlg:nxrg) ) 2363 pavement_subsurface_pars_f%pars_xyz = pavement_subsurface_pars_f%fill 2245 ENDIF 2246 ENDIF 2247 2248 IF ( pavement_subsurface_pars_f%from_file ) THEN 2249 CALL resize_array_4d_real( pavement_subsurface_pars_f%pars_xyz, & 2250 0, pavement_subsurface_pars_f%np-1, & 2251 0, pavement_subsurface_pars_f%nz-1, & 2252 nys, nyn, nxl, nxr ) 2364 2253 2365 2254 DO k2 = 0, pavement_subsurface_pars_f%nz-1 2366 2255 DO k = 0, pavement_subsurface_pars_f%np-1 2367 var_exchange_real(nys:nyn,nxl:nxr) = & 2368 var_dum_real_4d(k,k2,nys:nyn,nxl:nxr) 2369 CALL exchange_horiz_2d( var_exchange_real, nbgp ) 2370 pavement_subsurface_pars_f%pars_xyz(k,k2,:,:) = & 2371 var_exchange_real(:,:) 2256 CALL exchange_horiz_2d( & 2257 pavement_subsurface_pars_f%pars_xyz(k,k2,:,:), nbgp ) 2372 2258 ENDDO 2373 2259 ENDDO 2374 DEALLOCATE( var_dum_real_4d )2375 ENDIF2376 2377 !2378 !-- In case of non-cyclic boundary conditions, set Neumann conditions at the2379 !-- lateral boundaries.2380 IF ( .NOT. bc_ns_cyc ) THEN2381 IF ( nys == 0 ) THEN2382 IF ( albedo_type_f%from_file ) &2383 albedo_type_f%var(-1,:) = albedo_type_f%var(0,:)2384 IF ( pavement_type_f%from_file ) &2385 pavement_type_f%var(-1,:) = pavement_type_f%var(0,:)2386 IF ( soil_type_f%from_file ) THEN2387 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN2388 soil_type_f%var_2d(-1,:) = soil_type_f%var_2d(0,:)2389 ELSE2390 soil_type_f%var_3d(:,-1,:) = soil_type_f%var_3d(:,0,:)2391 ENDIF2392 ENDIF2393 IF ( vegetation_type_f%from_file ) &2394 vegetation_type_f%var(-1,:) = vegetation_type_f%var(0,:)2395 IF ( water_type_f%from_file ) &2396 water_type_f%var(-1,:) = water_type_f%var(0,:)2397 IF ( surface_fraction_f%from_file ) &2398 surface_fraction_f%frac(:,-1,:) = surface_fraction_f%frac(:,0,:)2399 IF ( building_pars_f%from_file ) &2400 building_pars_f%pars_xy(:,-1,:) = building_pars_f%pars_xy(:,0,:)2401 IF ( albedo_pars_f%from_file ) &2402 albedo_pars_f%pars_xy(:,-1,:) = albedo_pars_f%pars_xy(:,0,:)2403 IF ( pavement_pars_f%from_file ) &2404 pavement_pars_f%pars_xy(:,-1,:) = pavement_pars_f%pars_xy(:,0,:)2405 IF ( vegetation_pars_f%from_file ) &2406 vegetation_pars_f%pars_xy(:,-1,:) = &2407 vegetation_pars_f%pars_xy(:,0,:)2408 IF ( water_pars_f%from_file ) &2409 water_pars_f%pars_xy(:,-1,:) = water_pars_f%pars_xy(:,0,:)2410 IF ( root_area_density_lsm_f%from_file ) &2411 root_area_density_lsm_f%var(:,-1,:) = &2412 root_area_density_lsm_f%var(:,0,:)2413 IF ( soil_pars_f%from_file ) THEN2414 IF ( soil_pars_f%lod == 1 ) THEN2415 soil_pars_f%pars_xy(:,-1,:) = soil_pars_f%pars_xy(:,0,:)2416 ELSE2417 soil_pars_f%pars_xyz(:,:,-1,:) = soil_pars_f%pars_xyz(:,:,0,:)2418 ENDIF2419 ENDIF2420 IF ( pavement_subsurface_pars_f%from_file ) &2421 pavement_subsurface_pars_f%pars_xyz(:,:,-1,:) = &2422 pavement_subsurface_pars_f%pars_xyz(:,:,0,:)2423 ENDIF2424 2425 IF ( nyn == ny ) THEN2426 IF ( albedo_type_f%from_file ) &2427 albedo_type_f%var(ny+1,:) = albedo_type_f%var(ny,:)2428 IF ( pavement_type_f%from_file ) &2429 pavement_type_f%var(ny+1,:) = pavement_type_f%var(ny,:)2430 IF ( soil_type_f%from_file ) THEN2431 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN2432 soil_type_f%var_2d(ny+1,:) = soil_type_f%var_2d(ny,:)2433 ELSE2434 soil_type_f%var_3d(:,ny+1,:) = soil_type_f%var_3d(:,ny,:)2435 ENDIF2436 ENDIF2437 IF ( vegetation_type_f%from_file ) &2438 vegetation_type_f%var(ny+1,:) = vegetation_type_f%var(ny,:)2439 IF ( water_type_f%from_file ) &2440 water_type_f%var(ny+1,:) = water_type_f%var(ny,:)2441 IF ( surface_fraction_f%from_file ) &2442 surface_fraction_f%frac(:,ny+1,:) = &2443 surface_fraction_f%frac(:,ny,:)2444 IF ( building_pars_f%from_file ) &2445 building_pars_f%pars_xy(:,ny+1,:) = &2446 building_pars_f%pars_xy(:,ny,:)2447 IF ( albedo_pars_f%from_file ) &2448 albedo_pars_f%pars_xy(:,ny+1,:) = albedo_pars_f%pars_xy(:,ny,:)2449 IF ( pavement_pars_f%from_file ) &2450 pavement_pars_f%pars_xy(:,ny+1,:) = &2451 pavement_pars_f%pars_xy(:,ny,:)2452 IF ( vegetation_pars_f%from_file ) &2453 vegetation_pars_f%pars_xy(:,ny+1,:) = &2454 vegetation_pars_f%pars_xy(:,ny,:)2455 IF ( water_pars_f%from_file ) &2456 water_pars_f%pars_xy(:,ny+1,:) = water_pars_f%pars_xy(:,ny,:)2457 IF ( root_area_density_lsm_f%from_file ) &2458 root_area_density_lsm_f%var(:,ny+1,:) = &2459 root_area_density_lsm_f%var(:,ny,:)2460 IF ( soil_pars_f%from_file ) THEN2461 IF ( soil_pars_f%lod == 1 ) THEN2462 soil_pars_f%pars_xy(:,ny+1,:) = soil_pars_f%pars_xy(:,ny,:)2463 ELSE2464 soil_pars_f%pars_xyz(:,:,ny+1,:) = &2465 soil_pars_f%pars_xyz(:,:,ny,:)2466 ENDIF2467 ENDIF2468 IF ( pavement_subsurface_pars_f%from_file ) &2469 pavement_subsurface_pars_f%pars_xyz(:,:,ny+1,:) = &2470 pavement_subsurface_pars_f%pars_xyz(:,:,ny,:)2471 ENDIF2472 ENDIF2473 2474 IF ( .NOT. bc_lr_cyc ) THEN2475 IF ( nxl == 0 ) THEN2476 IF ( albedo_type_f%from_file ) &2477 albedo_type_f%var(:,-1) = albedo_type_f%var(:,0)2478 IF ( pavement_type_f%from_file ) &2479 pavement_type_f%var(:,-1) = pavement_type_f%var(:,0)2480 IF ( soil_type_f%from_file ) THEN2481 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN2482 soil_type_f%var_2d(:,-1) = soil_type_f%var_2d(:,0)2483 ELSE2484 soil_type_f%var_3d(:,:,-1) = soil_type_f%var_3d(:,:,0)2485 ENDIF2486 ENDIF2487 IF ( vegetation_type_f%from_file ) &2488 vegetation_type_f%var(:,-1) = vegetation_type_f%var(:,0)2489 IF ( water_type_f%from_file ) &2490 water_type_f%var(:,-1) = water_type_f%var(:,0)2491 IF ( surface_fraction_f%from_file ) &2492 surface_fraction_f%frac(:,:,-1) = surface_fraction_f%frac(:,:,0)2493 IF ( building_pars_f%from_file ) &2494 building_pars_f%pars_xy(:,:,-1) = building_pars_f%pars_xy(:,:,0)2495 IF ( albedo_pars_f%from_file ) &2496 albedo_pars_f%pars_xy(:,:,-1) = albedo_pars_f%pars_xy(:,:,0)2497 IF ( pavement_pars_f%from_file ) &2498 pavement_pars_f%pars_xy(:,:,-1) = pavement_pars_f%pars_xy(:,:,0)2499 IF ( vegetation_pars_f%from_file ) &2500 vegetation_pars_f%pars_xy(:,:,-1) = &2501 vegetation_pars_f%pars_xy(:,:,0)2502 IF ( water_pars_f%from_file ) &2503 water_pars_f%pars_xy(:,:,-1) = water_pars_f%pars_xy(:,:,0)2504 IF ( root_area_density_lsm_f%from_file ) &2505 root_area_density_lsm_f%var(:,:,-1) = &2506 root_area_density_lsm_f%var(:,:,0)2507 IF ( soil_pars_f%from_file ) THEN2508 IF ( soil_pars_f%lod == 1 ) THEN2509 soil_pars_f%pars_xy(:,:,-1) = soil_pars_f%pars_xy(:,:,0)2510 ELSE2511 soil_pars_f%pars_xyz(:,:,:,-1) = soil_pars_f%pars_xyz(:,:,:,0)2512 ENDIF2513 ENDIF2514 IF ( pavement_subsurface_pars_f%from_file ) &2515 pavement_subsurface_pars_f%pars_xyz(:,:,:,-1) = &2516 pavement_subsurface_pars_f%pars_xyz(:,:,:,0)2517 ENDIF2518 2519 IF ( nxr == nx ) THEN2520 IF ( albedo_type_f%from_file ) &2521 albedo_type_f%var(:,nx+1) = albedo_type_f%var(:,nx)2522 IF ( pavement_type_f%from_file ) &2523 pavement_type_f%var(:,nx+1) = pavement_type_f%var(:,nx)2524 IF ( soil_type_f%from_file ) THEN2525 IF ( ALLOCATED( soil_type_f%var_2d ) ) THEN2526 soil_type_f%var_2d(:,nx+1) = soil_type_f%var_2d(:,nx)2527 ELSE2528 soil_type_f%var_3d(:,:,nx+1) = soil_type_f%var_3d(:,:,nx)2529 ENDIF2530 ENDIF2531 IF ( vegetation_type_f%from_file ) &2532 vegetation_type_f%var(:,nx+1) = vegetation_type_f%var(:,nx)2533 IF ( water_type_f%from_file ) &2534 water_type_f%var(:,nx+1) = water_type_f%var(:,nx)2535 IF ( surface_fraction_f%from_file ) &2536 surface_fraction_f%frac(:,:,nx+1) = &2537 surface_fraction_f%frac(:,:,nx)2538 IF ( building_pars_f%from_file ) &2539 building_pars_f%pars_xy(:,:,nx+1) = &2540 building_pars_f%pars_xy(:,:,nx)2541 IF ( albedo_pars_f%from_file ) &2542 albedo_pars_f%pars_xy(:,:,nx+1) = albedo_pars_f%pars_xy(:,:,nx)2543 IF ( pavement_pars_f%from_file ) &2544 pavement_pars_f%pars_xy(:,:,nx+1) = &2545 pavement_pars_f%pars_xy(:,:,nx)2546 IF ( vegetation_pars_f%from_file ) &2547 vegetation_pars_f%pars_xy(:,:,nx+1) = &2548 vegetation_pars_f%pars_xy(:,:,nx)2549 IF ( water_pars_f%from_file ) &2550 water_pars_f%pars_xy(:,:,nx+1) = water_pars_f%pars_xy(:,:,nx)2551 IF ( root_area_density_lsm_f%from_file ) &2552 root_area_density_lsm_f%var(:,:,nx+1) = &2553 root_area_density_lsm_f%var(:,:,nx)2554 IF ( soil_pars_f%from_file ) THEN2555 IF ( soil_pars_f%lod == 1 ) THEN2556 soil_pars_f%pars_xy(:,:,nx+1) = soil_pars_f%pars_xy(:,:,nx)2557 ELSE2558 soil_pars_f%pars_xyz(:,:,:,nx+1) = &2559 soil_pars_f%pars_xyz(:,:,:,nx)2560 ENDIF2561 ENDIF2562 IF ( pavement_subsurface_pars_f%from_file ) &2563 pavement_subsurface_pars_f%pars_xyz(:,:,:,nx+1) = &2564 pavement_subsurface_pars_f%pars_xyz(:,:,:,nx)2565 ENDIF2566 2260 ENDIF 2567 2261 … … 2709 2403 INTEGER(iwp) :: num_vars !< number of variables in netcdf input file 2710 2404 INTEGER(iwp) :: skip_n_rows !< counting variable to skip rows while reading topography file 2711 2712 INTEGER(iwp), DIMENSION(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) :: var_exchange_int !< dummy variables used to exchange 32-bit Integer arrays2713 2405 2714 2406 REAL(wp) :: dum !< dummy variable to skip columns while reading topography file … … 2935 2627 !-- lateral boundaries. 2936 2628 IF ( building_id_f%from_file ) THEN 2937 var_exchange_int = building_id_f%fill 2938 var_exchange_int(nys:nyn,nxl:nxr) = building_id_f%var(nys:nyn,nxl:nxr) 2939 CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp ) 2940 DEALLOCATE( building_id_f%var ) 2941 ALLOCATE( building_id_f%var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) ) 2942 building_id_f%var = var_exchange_int 2943 2944 IF ( .NOT. bc_ns_cyc ) THEN 2945 IF ( nys == 0 ) building_id_f%var(-1,:) = building_id_f%var(0,:) 2946 IF ( nyn == ny ) building_id_f%var(ny+1,:) = building_id_f%var(ny,:) 2947 ENDIF 2948 IF ( .NOT. bc_lr_cyc ) THEN 2949 IF ( nxl == 0 ) building_id_f%var(:,-1) = building_id_f%var(:,0) 2950 IF ( nxr == nx ) building_id_f%var(:,nx+1) = building_id_f%var(:,nx) 2951 ENDIF 2629 CALL resize_array_2d_int32( building_id_f%var, nys, nyn, nxl, nxr ) 2630 CALL exchange_horiz_2d_int( building_id_f%var, nys, nyn, nxl, nxr, & 2631 nbgp ) 2952 2632 ENDIF 2953 2633 2954 2634 IF ( building_type_f%from_file ) THEN 2955 var_exchange_int = INT( building_type_f%fill, KIND = 4 ) 2956 var_exchange_int(nys:nyn,nxl:nxr) = & 2957 INT( building_type_f%var(nys:nyn,nxl:nxr), KIND = 4 ) 2958 CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp ) 2959 DEALLOCATE( building_type_f%var ) 2960 ALLOCATE( building_type_f%var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) ) 2961 building_type_f%var = INT( var_exchange_int, KIND = 1 ) 2962 2963 IF ( .NOT. bc_ns_cyc ) THEN 2964 IF ( nys == 0 ) building_type_f%var(-1,:) = building_type_f%var(0,:) 2965 IF ( nyn == ny ) building_type_f%var(ny+1,:) = building_type_f%var(ny,:) 2966 ENDIF 2967 IF ( .NOT. bc_lr_cyc ) THEN 2968 IF ( nxl == 0 ) building_type_f%var(:,-1) = building_type_f%var(:,0) 2969 IF ( nxr == nx ) building_type_f%var(:,nx+1) = building_type_f%var(:,nx) 2970 ENDIF 2635 CALL resize_array_2d_int8( building_type_f%var, nys, nyn, nxl, nxr ) 2636 CALL exchange_horiz_2d_byte( building_type_f%var, nys, nyn, nxl, nxr, & 2637 nbgp ) 2971 2638 ENDIF 2972 2639 … … 4477 4144 ! Description: 4478 4145 ! ------------ 4146 !> Resize 8-bit 2D Integer array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg) 4147 !------------------------------------------------------------------------------! 4148 SUBROUTINE resize_array_2d_int8( var, js, je, is, ie ) 4149 4150 IMPLICIT NONE 4151 4152 INTEGER(iwp) :: je !< upper index bound along y direction 4153 INTEGER(iwp) :: js !< lower index bound along y direction 4154 INTEGER(iwp) :: ie !< upper index bound along x direction 4155 INTEGER(iwp) :: is !< lower index bound along x direction 4156 4157 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var !< treated variable 4158 INTEGER(KIND=1), DIMENSION(:,:), ALLOCATABLE :: var_tmp !< temporary copy 4159 ! 4160 !-- Allocate temporary variable 4161 ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4162 ! 4163 !-- Temporary copy of the variable 4164 var_tmp(js:je,is:ie) = var(js:je,is:ie) 4165 ! 4166 !-- Resize the array 4167 DEALLOCATE( var ) 4168 ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4169 ! 4170 !-- Transfer temporary copy back to original array 4171 var(js:je,is:ie) = var_tmp(js:je,is:ie) 4172 4173 END SUBROUTINE resize_array_2d_int8 4174 4175 !------------------------------------------------------------------------------! 4176 ! Description: 4177 ! ------------ 4178 !> Resize 32-bit 2D Integer array: (nys:nyn,nxl:nxr) -> (nysg:nyng,nxlg:nxrg) 4179 !------------------------------------------------------------------------------! 4180 SUBROUTINE resize_array_2d_int32( var, js, je, is, ie ) 4181 4182 IMPLICIT NONE 4183 4184 INTEGER(iwp) :: je !< upper index bound along y direction 4185 INTEGER(iwp) :: js !< lower index bound along y direction 4186 INTEGER(iwp) :: ie !< upper index bound along x direction 4187 INTEGER(iwp) :: is !< lower index bound along x direction 4188 4189 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var !< treated variable 4190 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: var_tmp !< temporary copy 4191 ! 4192 !-- Allocate temporary variable 4193 ALLOCATE( var_tmp(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4194 ! 4195 !-- Temporary copy of the variable 4196 var_tmp(js:je,is:ie) = var(js:je,is:ie) 4197 ! 4198 !-- Resize the array 4199 DEALLOCATE( var ) 4200 ALLOCATE( var(js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4201 ! 4202 !-- Transfer temporary copy back to original array 4203 var(js:je,is:ie) = var_tmp(js:je,is:ie) 4204 4205 END SUBROUTINE resize_array_2d_int32 4206 4207 !------------------------------------------------------------------------------! 4208 ! Description: 4209 ! ------------ 4210 !> Resize 8-bit 3D Integer array: (:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg) 4211 !------------------------------------------------------------------------------! 4212 SUBROUTINE resize_array_3d_int8( var, ks, ke, js, je, is, ie ) 4213 4214 IMPLICIT NONE 4215 4216 INTEGER(iwp) :: je !< upper index bound along y direction 4217 INTEGER(iwp) :: js !< lower index bound along y direction 4218 INTEGER(iwp) :: ie !< upper index bound along x direction 4219 INTEGER(iwp) :: is !< lower index bound along x direction 4220 INTEGER(iwp) :: ke !< upper bound of treated array in z-direction 4221 INTEGER(iwp) :: ks !< lower bound of treated array in z-direction 4222 4223 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var !< treated variable 4224 INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 4225 ! 4226 !-- Allocate temporary variable 4227 ALLOCATE( var_tmp(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4228 ! 4229 !-- Temporary copy of the variable 4230 var_tmp(ks:ke,js:je,is:ie) = var(ks:ke,js:je,is:ie) 4231 ! 4232 !-- Resize the array 4233 DEALLOCATE( var ) 4234 ALLOCATE( var(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4235 ! 4236 !-- Transfer temporary copy back to original array 4237 var(ks:ke,js:je,is:ie) = var_tmp(ks:ke,js:je,is:ie) 4238 4239 END SUBROUTINE resize_array_3d_int8 4240 4241 !------------------------------------------------------------------------------! 4242 ! Description: 4243 ! ------------ 4244 !> Resize 3D Real array: (:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg) 4245 !------------------------------------------------------------------------------! 4246 SUBROUTINE resize_array_3d_real( var, ks, ke, js, je, is, ie ) 4247 4248 IMPLICIT NONE 4249 4250 INTEGER(iwp) :: je !< upper index bound along y direction 4251 INTEGER(iwp) :: js !< lower index bound along y direction 4252 INTEGER(iwp) :: ie !< upper index bound along x direction 4253 INTEGER(iwp) :: is !< lower index bound along x direction 4254 INTEGER(iwp) :: ke !< upper bound of treated array in z-direction 4255 INTEGER(iwp) :: ks !< lower bound of treated array in z-direction 4256 4257 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var !< treated variable 4258 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 4259 ! 4260 !-- Allocate temporary variable 4261 ALLOCATE( var_tmp(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4262 ! 4263 !-- Temporary copy of the variable 4264 var_tmp(ks:ke,js:je,is:ie) = var(ks:ke,js:je,is:ie) 4265 ! 4266 !-- Resize the array 4267 DEALLOCATE( var ) 4268 ALLOCATE( var(ks:ke,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4269 ! 4270 !-- Transfer temporary copy back to original array 4271 var(ks:ke,js:je,is:ie) = var_tmp(ks:ke,js:je,is:ie) 4272 4273 END SUBROUTINE resize_array_3d_real 4274 4275 !------------------------------------------------------------------------------! 4276 ! Description: 4277 ! ------------ 4278 !> Resize 4D Real array: (:,:,nys:nyn,nxl:nxr) -> (:,nysg:nyng,nxlg:nxrg) 4279 !------------------------------------------------------------------------------! 4280 SUBROUTINE resize_array_4d_real( var, k1s, k1e, k2s, k2e, js, je, is, ie ) 4281 4282 IMPLICIT NONE 4283 4284 INTEGER(iwp) :: je !< upper index bound along y direction 4285 INTEGER(iwp) :: js !< lower index bound along y direction 4286 INTEGER(iwp) :: ie !< upper index bound along x direction 4287 INTEGER(iwp) :: is !< lower index bound along x direction 4288 INTEGER(iwp) :: k1e !< upper bound of treated array in z-direction 4289 INTEGER(iwp) :: k1s !< lower bound of treated array in z-direction 4290 INTEGER(iwp) :: k2e !< upper bound of treated array along parameter space 4291 INTEGER(iwp) :: k2s !< lower bound of treated array along parameter space 4292 4293 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var !< treated variable 4294 REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: var_tmp !< temporary copy 4295 ! 4296 !-- Allocate temporary variable 4297 ALLOCATE( var_tmp(k1s:k1e,k2s:k2e,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4298 ! 4299 !-- Temporary copy of the variable 4300 var_tmp(k1s:k1e,k2s:k2e,js:je,is:ie) = var(k1s:k1e,k2s:k2e,js:je,is:ie) 4301 ! 4302 !-- Resize the array 4303 DEALLOCATE( var ) 4304 ALLOCATE( var(k1s:k1e,k2s:k2e,js-nbgp:je+nbgp,is-nbgp:ie+nbgp) ) 4305 ! 4306 !-- Transfer temporary copy back to original array 4307 var(k1s:k1e,k2s:k2e,js:je,is:ie) = var_tmp(k1s:k1e,k2s:k2e,js:je,is:ie) 4308 4309 END SUBROUTINE resize_array_4d_real 4310 4311 !------------------------------------------------------------------------------! 4312 ! Description: 4313 ! ------------ 4479 4314 !> Vertical interpolation and extrapolation of 1D variables. 4480 4315 !------------------------------------------------------------------------------!
Note: See TracChangeset
for help on using the changeset viewer.
