Changeset 1886 for palm/trunk/SOURCE
- Timestamp:
- Apr 21, 2016 11:20:47 AM (9 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/init_grid.f90 (modified) (24 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/init_grid.f90
r1846 r1886 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 21 ! Bugfix: setting advection flags near walls 22 ! reformulated index values for nzb_v_inner 23 ! variable discriptions added in declaration block 22 24 ! 23 25 ! Former revisions: … … 198 200 IMPLICIT NONE 199 201 200 INTEGER(iwp) :: bh !< 201 INTEGER(iwp) :: blx !< 202 INTEGER(iwp) :: bly !< 203 INTEGER(iwp) :: bxl !< 204 INTEGER(iwp) :: bxr !< 205 INTEGER(iwp) :: byn !< 206 INTEGER(iwp) :: bys !< 207 INTEGER(iwp) :: ch !< 208 INTEGER(iwp) :: cwx !< 209 INTEGER(iwp) :: cwy !< 210 INTEGER(iwp) :: cxl !< 211 INTEGER(iwp) :: cxr !< 212 INTEGER(iwp) :: cyn !< 213 INTEGER(iwp) :: cys !< 214 INTEGER(iwp) :: gls !< 215 INTEGER(iwp) :: i !< 216 INTEGER(iwp) :: ii !< 217 INTEGER(iwp) :: inc !< 218 INTEGER(iwp) :: j !< 219 INTEGER(iwp) :: k !< 220 INTEGER(iwp) :: l !< 221 INTEGER(iwp) :: nxl_l !< 222 INTEGER(iwp) :: nxr_l !< 223 INTEGER(iwp) :: nyn_l !< 224 INTEGER(iwp) :: nys_l !< 225 INTEGER(iwp) :: nzb_si !< 226 INTEGER(iwp) :: nzt_l !< 227 INTEGER(iwp) :: vi !< 228 229 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: vertical_influence !< 230 231 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_nl !< 232 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_nr !< 233 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_sl !< 234 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_sr !< 235 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_l !< 236 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_n !< 237 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_r !< 238 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_s !< 239 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nzb_local !< 240 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nzb_tmp !< 241 242 LOGICAL :: flag_set = .FALSE. !< 243 244 REAL(wp) :: dx_l !< 245 REAL(wp) :: dy_l !< 246 REAL(wp) :: dz_stretched !< 247 248 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: topo_height !< 202 INTEGER(iwp) :: bh !< temporary vertical index of building height 203 INTEGER(iwp) :: blx !< grid point number of building size along x 204 INTEGER(iwp) :: bly !< grid point number of building size along y 205 INTEGER(iwp) :: bxl !< index for left building wall 206 INTEGER(iwp) :: bxr !< index for right building wall 207 INTEGER(iwp) :: byn !< index for north building wall 208 INTEGER(iwp) :: bys !< index for south building wall 209 INTEGER(iwp) :: ch !< temporary vertical index for canyon height 210 INTEGER(iwp) :: cwx !< grid point number of canyon size along x 211 INTEGER(iwp) :: cwy !< grid point number of canyon size along y 212 INTEGER(iwp) :: cxl !< index for left canyon wall 213 INTEGER(iwp) :: cxr !< index for right canyon wall 214 INTEGER(iwp) :: cyn !< index for north canyon wall 215 INTEGER(iwp) :: cys !< index for south canyon wall 216 INTEGER(iwp) :: gls !< number of lateral ghost points at total model 217 !< domain boundaries required for multigrid solver 218 INTEGER(iwp) :: i !< index variable along x 219 INTEGER(iwp) :: ii !< loop variable for reading topography file 220 INTEGER(iwp) :: inc !< incremental parameter for coarsening grid level 221 INTEGER(iwp) :: j !< index variable along y 222 INTEGER(iwp) :: k !< index variable along z 223 INTEGER(iwp) :: l !< loop variable 224 INTEGER(iwp) :: nxl_l !< index of left PE boundary for multigrid level 225 INTEGER(iwp) :: nxr_l !< index of right PE boundary for multigrid level 226 INTEGER(iwp) :: nyn_l !< index of north PE boundary for multigrid level 227 INTEGER(iwp) :: nys_l !< index of south PE boundary for multigrid level 228 INTEGER(iwp) :: nzb_si !< dummy index for local nzb_s_inner 229 INTEGER(iwp) :: nzt_l !< index of top PE boundary for multigrid level 230 INTEGER(iwp) :: vi !< dummy for vertical influence 231 232 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: & 233 vertical_influence !< number of vertical grid points above 234 !< obstacle where adjustment of near- 235 !< wall mixing length is required 236 237 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_nl !< index of 238 !< north-left corner location to limit 239 !< near-wall mixing length 240 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_nr !< north-right 241 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_sl !< south-left 242 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: corner_sr !< south-right 243 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_l !< distance to 244 !< adjacent left-facing 245 !< wall 246 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_n !< north-facing 247 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_r !< right-facing 248 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: wall_s !< right-facing 249 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nzb_local !< index for topography 250 !< top at cell-center 251 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: nzb_tmp !< dummy to calculate 252 !< topography indices 253 !< on u- and v-grid 254 255 LOGICAL :: flag_set = .FALSE. !< steering variable for advection flags 256 257 REAL(wp) :: dx_l !< grid spacing along x on different multigrid level 258 REAL(wp) :: dy_l !< grid spacing along y on different multigrid level 259 REAL(wp) :: dz_stretched !< stretched vertical grid spacing 260 261 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: topo_height !< input variable for 262 !< topography height 249 263 250 264 … … 908 922 ENDDO 909 923 ENDDO 910 nzb_v_inner = nzb_tmp(nys -nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp)924 nzb_v_inner = nzb_tmp(nysg:nyng,nxlg:nxrg) 911 925 912 926 ! … … 1219 1233 wall_flags_00 = 0 1220 1234 1221 IF ( scalar_advec == 'ws-scheme' .OR. &1235 IF ( scalar_advec == 'ws-scheme' .OR. & 1222 1236 scalar_advec == 'ws-scheme-mono' ) THEN 1223 1237 ! … … 1232 1246 !-- scalar - x-direction 1233 1247 !-- WS1 (0), WS3 (1), WS5 (2) 1234 IF ( k <= nzb_s_inner(j,i+1) .OR. & 1235 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 1248 IF ( ( k <= nzb_s_inner(j,i+1) .OR. k <= nzb_s_inner(j,i+2) & 1249 .OR. k <= nzb_s_inner(j,i-1) ) & 1250 .OR. ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 1236 1251 .AND. i == nxl ) .OR. & 1237 1252 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 1239 1254 THEN 1240 1255 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 ) 1241 ELSEIF ( k <= nzb_s_inner(j,i+2) .OR. k <= nzb_s_inner(j,i-1) & 1256 ELSEIF ( ( k <= nzb_s_inner(j,i+3) .AND. k > nzb_s_inner(j,i+1)& 1257 .AND. k > nzb_s_inner(j,i+2)& 1258 .AND. k > nzb_s_inner(j,i-1)& 1259 ) .OR. & 1260 ( k <= nzb_s_inner(j,i-2) .AND. k > nzb_s_inner(j,i+1)& 1261 .AND. k > nzb_s_inner(j,i+2)& 1262 .AND. k > nzb_s_inner(j,i-1)& 1263 ) & 1242 1264 .OR. & 1243 1265 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 1247 1269 THEN 1248 1270 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 ) 1249 ELSE 1271 ELSEIF ( k > nzb_s_inner(j,i+1) .AND. k > nzb_s_inner(j,i+2) & 1272 .AND. k > nzb_s_inner(j,i+3) .AND. k > nzb_s_inner(j,i-1) & 1273 .AND. k > nzb_s_inner(j,i-2) ) & 1274 THEN 1250 1275 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 2 ) 1251 1276 ENDIF … … 1253 1278 !-- scalar - y-direction 1254 1279 !-- WS1 (3), WS3 (4), WS5 (5) 1255 IF ( k <= nzb_s_inner(j+1,i) .OR. & 1280 IF ( ( k <= nzb_s_inner(j+1,i) .OR. k <= nzb_s_inner(j+2,i) & 1281 .OR. k <= nzb_s_inner(j-1,i) ) & 1282 .OR. & 1256 1283 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 1257 1284 .AND. j == nys ) .OR. & … … 1262 1289 ! 1263 1290 !-- WS3 1264 ELSEIF ( k <= nzb_s_inner(j+2,i) .OR. k <= nzb_s_inner(j-1,i) & 1265 .OR. & 1291 ELSEIF ( ( k <= nzb_s_inner(j+3,i) .AND. k > nzb_s_inner(j+1,i)& 1292 .AND. k > nzb_s_inner(j+2,i)& 1293 .AND. k > nzb_s_inner(j-1,i)& 1294 ) .OR. & 1295 ( k <= nzb_s_inner(j-2,i) .AND. k > nzb_s_inner(j+1,i)& 1296 .AND. k > nzb_s_inner(j+2,i)& 1297 .AND. k > nzb_s_inner(j-1,i)& 1298 ) & 1299 .OR. & 1266 1300 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 1267 1301 .AND. j == nysv ) .OR. & … … 1272 1306 ! 1273 1307 !-- WS5 1274 ELSE 1308 ELSEIF ( k > nzb_s_inner(j+1,i) .AND. k > nzb_s_inner(j+2,i) & 1309 .AND. k > nzb_s_inner(j+3,i) .AND. k > nzb_s_inner(j-1,i) & 1310 .AND. k > nzb_s_inner(j-2,i) ) & 1311 THEN 1275 1312 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 5 ) 1276 1313 ENDIF … … 1288 1325 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 8 ) 1289 1326 ENDIF 1327 1290 1328 ENDDO 1291 1329 ENDDO … … 1312 1350 !-- u component - x-direction 1313 1351 !-- WS1 (9), WS3 (10), WS5 (11) 1314 IF ( k <= nzb_u_inner(j,i+1) .OR.&1352 IF ( k <= nzb_u_inner(j,i+1) .OR. & 1315 1353 ( ( inflow_l .OR. outflow_l .OR. nest_bound_l ) & 1316 1354 .AND. i <= nxlu ) .OR. & … … 1319 1357 THEN 1320 1358 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 9 ) 1321 ELSEIF ( k <= nzb_u_inner(j,i+2) .OR. k <= nzb_u_inner(j,i-1) & 1322 .OR. & 1359 ELSEIF ( ( k <= nzb_u_inner(j,i+2) .AND. & 1360 k > nzb_u_inner(j,i+1) ) .OR. & 1361 k <= nzb_u_inner(j,i-1) & 1362 .OR. & 1323 1363 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & 1324 1364 .AND. i == nxr-1 ) .OR. & … … 1330 1370 !-- Clear flag for WS1 1331 1371 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 9 ) 1332 ELSE 1372 ELSEIF ( k > nzb_u_inner(j,i+1) .AND. k > nzb_u_inner(j,i+2) & 1373 .AND. k > nzb_u_inner(j,i-1) ) & 1374 THEN 1333 1375 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 11 ) 1334 1376 ! … … 1346 1388 THEN 1347 1389 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 ) 1348 ELSEIF ( k <= nzb_u_inner(j+2,i) .OR. k <= nzb_u_inner(j-1,i) & 1349 .OR. & 1390 ELSEIF ( ( k <= nzb_u_inner(j+2,i) .AND. & 1391 k > nzb_u_inner(j+1,i) ) .OR. & 1392 k <= nzb_u_inner(j-1,i) & 1393 .OR. & 1350 1394 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 1351 1395 .AND. j == nysv ) .OR. & … … 1357 1401 !-- Clear flag for WS1 1358 1402 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 12 ) 1359 ELSE 1403 ELSEIF ( k > nzb_u_inner(j+1,i) .AND. k > nzb_u_inner(j+2,i) & 1404 .AND. k > nzb_u_inner(j-1,i) ) & 1405 THEN 1360 1406 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 14 ) 1361 1407 ! … … 1402 1448 ! 1403 1449 !-- WS3 1404 ELSEIF ( k <= nzb_v_inner(j,i+2) .OR. k <= nzb_v_inner(j,i-1) & 1450 ELSEIF ( ( k <= nzb_v_inner(j,i+2) .AND. & 1451 k > nzb_v_inner(j,i+1) ) .OR. & 1452 k <= nzb_v_inner(j,i-1) & 1405 1453 .OR. & 1406 1454 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & … … 1413 1461 !-- Clear flag for WS1 1414 1462 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 18 ) 1415 ELSE 1463 ELSEIF ( k > nzb_v_inner(j,i+1) .AND. k > nzb_v_inner(j,i+2) & 1464 .AND. k > nzb_v_inner(j,i-1) ) & 1465 THEN 1416 1466 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 20 ) 1417 1467 ! … … 1429 1479 THEN 1430 1480 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 ) 1431 ELSEIF ( k <= nzb_v_inner(j+2,i) .OR. k <= nzb_v_inner(j-1,i) & 1432 .OR. & 1481 ELSEIF ( ( k <= nzb_v_inner(j+2,i) .AND. & 1482 k > nzb_v_inner(j+1,i) ) .OR. & 1483 k <= nzb_v_inner(j-1,i) & 1484 .OR. & 1433 1485 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 1434 1486 .AND. j == nysv+1) .OR. & … … 1440 1492 !-- Clear flag for WS1 1441 1493 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 21 ) 1442 ELSE 1494 ELSEIF ( k > nzb_v_inner(j+1,i) .AND. k > nzb_v_inner(j+2,i) & 1495 .AND. k > nzb_v_inner(j-1,i) ) & 1496 THEN 1443 1497 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 ) 1444 1498 ! … … 1482 1536 THEN 1483 1537 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 ) 1484 ELSEIF ( k <= nzb_w_inner(j,i+2) .OR. k <= nzb_w_inner(j,i-1) & 1485 .OR. & 1538 ELSEIF ( ( k <= nzb_w_inner(j,i+2) .AND. & 1539 k > nzb_w_inner(j,i+1) ) .OR. & 1540 k <= nzb_w_inner(j,i-1) & 1541 .OR. & 1486 1542 ( ( inflow_r .OR. outflow_r .OR. nest_bound_r ) & 1487 1543 .AND. i == nxr-1 ) .OR. & … … 1493 1549 !-- Clear flag for WS1 1494 1550 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 27 ) 1495 ELSE 1551 ELSEIF ( k > nzb_w_inner(j,i+1) .AND. k > nzb_w_inner(j,i+2) & 1552 .AND. k > nzb_w_inner(j,i-1) ) & 1553 THEN 1496 1554 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i),29 ) 1497 1555 ! … … 1509 1567 THEN 1510 1568 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 ) 1511 ELSEIF ( k <= nzb_w_inner(j+2,i) .OR. k <= nzb_w_inner(j-1,i) & 1512 .OR. & 1569 ELSEIF ( ( k <= nzb_w_inner(j+2,i) .AND. & 1570 k > nzb_w_inner(j+1,i) ) .OR. & 1571 k <= nzb_w_inner(j-1,i) & 1572 .OR. & 1513 1573 ( ( inflow_s .OR. outflow_s .OR. nest_bound_s ) & 1514 1574 .AND. j == nysv ) .OR. & … … 1520 1580 !-- Clear flag for WS1 1521 1581 wall_flags_0(k,j,i) = IBCLR( wall_flags_0(k,j,i), 30 ) 1522 ELSE 1582 ELSEIF ( k > nzb_w_inner(j+1,i) .AND. k > nzb_w_inner(j+2,i) & 1583 .AND. k > nzb_w_inner(j-1,i) ) & 1584 THEN 1523 1585 wall_flags_00(k,j,i) = IBSET( wall_flags_00(k,j,i), 0 ) 1524 1586 !
Note: See TracChangeset
for help on using the changeset viewer.
