Changeset 3542 for palm/trunk/SOURCE/netcdf_data_input_mod.f90
- Timestamp:
- Nov 20, 2018 5:04:13 PM (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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.