Changeset 4329 for palm/trunk/SOURCE/init_grid.f90
- Timestamp:
- Dec 10, 2019 3:46:36 PM (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/init_grid.f90
r4328 r4329 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Renamed wall_flags_0 to wall_flags_static_0 28 ! 29 ! 4328 2019-12-09 18:53:04Z suehring 27 30 ! Minor change in nzb_max computation. Commentation added. 28 31 ! … … 673 676 ! 674 677 !-- Determine local topography height on scalar and w-grid. Note, setting 675 !-- lateral boundary values is not necessary, realized via wall_flags_ 0678 !-- lateral boundary values is not necessary, realized via wall_flags_static_0 676 679 !-- array. Further, please note that loop bounds are different from 677 680 !-- nxl to nxr and nys to nyn on south and right model boundary, hence, … … 2318 2321 USE indices, & 2319 2322 ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb, & 2320 nzt, topo_top_ind, wall_flags_ 02323 nzt, topo_top_ind, wall_flags_static_0 2321 2324 2322 2325 USE kinds … … 2331 2334 INTEGER(iwp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: topo !< input array for 3D topography and dummy array for setting "outer"-flags 2332 2335 2333 ALLOCATE( wall_flags_ 0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )2334 wall_flags_ 0 = 02336 ALLOCATE( wall_flags_static_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ) 2337 wall_flags_static_0 = 0 2335 2338 ! 2336 2339 !-- Set-up topography flags. First, set flags only for s, u, v and w-grid. … … 2342 2345 !-- scalar grid 2343 2346 IF ( BTEST( topo(k,j,i), 0 ) ) & 2344 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 )2347 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 0 ) 2345 2348 ! 2346 2349 !-- u grid 2347 2350 IF ( BTEST( topo(k,j,i), 0 ) .AND. & 2348 2351 BTEST( topo(k,j,i-1), 0 ) ) & 2349 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 )2352 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 1 ) 2350 2353 ! 2351 2354 !-- v grid 2352 2355 IF ( BTEST( topo(k,j,i), 0 ) .AND. & 2353 2356 BTEST( topo(k,j-1,i), 0 ) ) & 2354 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 2 )2357 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 2 ) 2355 2358 2356 2359 ENDDO … … 2361 2364 IF ( BTEST( topo(k,j,i), 0 ) .AND. & 2362 2365 BTEST( topo(k+1,j,i), 0 ) ) & 2363 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 3 )2364 ENDDO 2365 wall_flags_ 0(nzt+1,j,i) = IBSET( wall_flags_0(nzt+1,j,i), 3 )2366 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 3 ) 2367 ENDDO 2368 wall_flags_static_0(nzt+1,j,i) = IBSET( wall_flags_static_0(nzt+1,j,i), 3 ) 2366 2369 2367 2370 ENDDO 2368 2371 ENDDO 2369 2372 2370 CALL exchange_horiz_int( wall_flags_ 0, nys, nyn, nxl, nxr, nzt, nbgp )2373 CALL exchange_horiz_int( wall_flags_static_0, nys, nyn, nxl, nxr, nzt, nbgp ) 2371 2374 ! 2372 2375 !-- Set outer array for scalars to mask near-surface grid points. Note, on … … 2376 2379 DO j = nys, nyn 2377 2380 DO k = nzb, nzt+1 2378 IF ( BTEST( wall_flags_ 0(k,j-1,i), 0 ) .AND. &2379 BTEST( wall_flags_ 0(k,j+1,i), 0 ) .AND. &2380 BTEST( wall_flags_ 0(k,j,i-1), 0 ) .AND. &2381 BTEST( wall_flags_ 0(k,j,i+1), 0 ) .AND. &2382 BTEST( wall_flags_ 0(k,j-1,i-1), 0 ) .AND. &2383 BTEST( wall_flags_ 0(k,j+1,i-1), 0 ) .AND. &2384 BTEST( wall_flags_ 0(k,j-1,i+1), 0 ) .AND. &2385 BTEST( wall_flags_ 0(k,j+1,i+1), 0 ) ) &2386 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 24 )2381 IF ( BTEST( wall_flags_static_0(k,j-1,i), 0 ) .AND. & 2382 BTEST( wall_flags_static_0(k,j+1,i), 0 ) .AND. & 2383 BTEST( wall_flags_static_0(k,j,i-1), 0 ) .AND. & 2384 BTEST( wall_flags_static_0(k,j,i+1), 0 ) .AND. & 2385 BTEST( wall_flags_static_0(k,j-1,i-1), 0 ) .AND. & 2386 BTEST( wall_flags_static_0(k,j+1,i-1), 0 ) .AND. & 2387 BTEST( wall_flags_static_0(k,j-1,i+1), 0 ) .AND. & 2388 BTEST( wall_flags_static_0(k,j+1,i+1), 0 ) ) & 2389 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 24 ) 2387 2390 ENDDO 2388 2391 ENDDO … … 2408 2411 !-- effect on the flow is negligible. 2409 2412 IF ( constant_flux_layer .OR. use_surface_fluxes ) THEN 2410 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) ) &2411 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 8 )2413 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) ) & 2414 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 8 ) 2412 2415 ELSE 2413 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 8 )2416 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 8 ) 2414 2417 ENDIF 2415 2418 … … 2418 2421 !-- Special flag to control vertical diffusion at model top - former 2419 2422 !-- nzt_diff 2420 wall_flags_ 0(:,j,i) = IBSET( wall_flags_0(:,j,i), 9 )2423 wall_flags_static_0(:,j,i) = IBSET( wall_flags_static_0(:,j,i), 9 ) 2421 2424 IF ( use_top_fluxes ) & 2422 wall_flags_ 0(nzt+1,j,i) = IBCLR( wall_flags_0(nzt+1,j,i), 9 )2425 wall_flags_static_0(nzt+1,j,i) = IBCLR( wall_flags_static_0(nzt+1,j,i), 9 ) 2423 2426 2424 2427 … … 2429 2432 !-- topography, as well as initialize u with zero one grid point outside 2430 2433 !-- of topography. 2431 IF ( BTEST( wall_flags_ 0(k-1,j,i), 1 ) .AND. &2432 BTEST( wall_flags_ 0(k,j,i), 1 ) .AND. &2433 BTEST( wall_flags_ 0(k+1,j,i), 1 ) ) &2434 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 20 )2434 IF ( BTEST( wall_flags_static_0(k-1,j,i), 1 ) .AND. & 2435 BTEST( wall_flags_static_0(k,j,i), 1 ) .AND. & 2436 BTEST( wall_flags_static_0(k+1,j,i), 1 ) ) & 2437 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 20 ) 2435 2438 ! 2436 2439 !-- Special flag on v grid, former nzb_v_inner + 1, required … … 2438 2441 !-- topography, as well as initialize v with zero one grid point outside 2439 2442 !-- of topography. 2440 IF ( BTEST( wall_flags_ 0(k-1,j,i), 2 ) .AND. &2441 BTEST( wall_flags_ 0(k,j,i), 2 ) .AND. &2442 BTEST( wall_flags_ 0(k+1,j,i), 2 ) ) &2443 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )2443 IF ( BTEST( wall_flags_static_0(k-1,j,i), 2 ) .AND. & 2444 BTEST( wall_flags_static_0(k,j,i), 2 ) .AND. & 2445 BTEST( wall_flags_static_0(k+1,j,i), 2 ) ) & 2446 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 21 ) 2444 2447 ! 2445 2448 !-- Special flag on scalar grid, former nzb_s_inner+1. Used for 2446 2449 !-- lpm_sgs_tke 2447 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &2448 BTEST( wall_flags_ 0(k-1,j,i), 0 ) .AND. &2449 BTEST( wall_flags_ 0(k+1,j,i), 0 ) ) &2450 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 25 )2450 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 2451 BTEST( wall_flags_static_0(k-1,j,i), 0 ) .AND. & 2452 BTEST( wall_flags_static_0(k+1,j,i), 0 ) ) & 2453 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 25 ) 2451 2454 ! 2452 2455 !-- Special flag on scalar grid, nzb_diff_s_outer - 1, required in 2453 2456 !-- in production_e 2454 2457 IF ( constant_flux_layer .OR. use_surface_fluxes ) THEN 2455 IF ( BTEST( wall_flags_ 0(k,j,i), 24 ) .AND. &2456 BTEST( wall_flags_ 0(k-1,j,i), 24 ) .AND. &2457 BTEST( wall_flags_ 0(k+1,j,i), 0 ) ) &2458 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 29 )2458 IF ( BTEST( wall_flags_static_0(k,j,i), 24 ) .AND. & 2459 BTEST( wall_flags_static_0(k-1,j,i), 24 ) .AND. & 2460 BTEST( wall_flags_static_0(k+1,j,i), 0 ) ) & 2461 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 29 ) 2459 2462 ELSE 2460 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) ) &2461 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 29 )2463 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) ) & 2464 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 29 ) 2462 2465 ENDIF 2463 2466 ! … … 2465 2468 !-- in production_e 2466 2469 IF ( constant_flux_layer .OR. use_surface_fluxes ) THEN 2467 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &2468 BTEST( wall_flags_ 0(k-1,j,i), 0 ) .AND. &2469 BTEST( wall_flags_ 0(k+1,j,i), 0 ) ) &2470 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )2470 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 2471 BTEST( wall_flags_static_0(k-1,j,i), 0 ) .AND. & 2472 BTEST( wall_flags_static_0(k+1,j,i), 0 ) ) & 2473 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 30 ) 2471 2474 ELSE 2472 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) ) &2473 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )2475 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) ) & 2476 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 30 ) 2474 2477 ENDIF 2475 2478 ENDDO … … 2479 2482 ! 2480 2483 !-- Scalar grid 2481 IF ( BTEST( wall_flags_ 0(k-1,j,i), 0 ) .AND. &2482 .NOT. BTEST( wall_flags_ 0(k,j,i), 0 ) ) &2483 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 13 )2484 IF ( BTEST( wall_flags_static_0(k-1,j,i), 0 ) .AND. & 2485 .NOT. BTEST( wall_flags_static_0(k,j,i), 0 ) ) & 2486 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 13 ) 2484 2487 ! 2485 2488 !-- Downward facing wall on u grid 2486 IF ( BTEST( wall_flags_ 0(k-1,j,i), 1 ) .AND. &2487 .NOT. BTEST( wall_flags_ 0(k,j,i), 1 ) ) &2488 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 15 )2489 IF ( BTEST( wall_flags_static_0(k-1,j,i), 1 ) .AND. & 2490 .NOT. BTEST( wall_flags_static_0(k,j,i), 1 ) ) & 2491 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 15 ) 2489 2492 ! 2490 2493 !-- Downward facing wall on v grid 2491 IF ( BTEST( wall_flags_ 0(k-1,j,i), 2 ) .AND. &2492 .NOT. BTEST( wall_flags_ 0(k,j,i), 2 ) ) &2493 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 17 )2494 IF ( BTEST( wall_flags_static_0(k-1,j,i), 2 ) .AND. & 2495 .NOT. BTEST( wall_flags_static_0(k,j,i), 2 ) ) & 2496 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 17 ) 2494 2497 ! 2495 2498 !-- Downward facing wall on w grid 2496 IF ( BTEST( wall_flags_ 0(k-1,j,i), 3 ) .AND. &2497 .NOT. BTEST( wall_flags_ 0(k,j,i), 3 ) ) &2498 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 19 )2499 IF ( BTEST( wall_flags_static_0(k-1,j,i), 3 ) .AND. & 2500 .NOT. BTEST( wall_flags_static_0(k,j,i), 3 ) ) & 2501 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 19 ) 2499 2502 ENDDO 2500 2503 ! … … 2503 2506 ! 2504 2507 !-- Upward facing wall on scalar grid 2505 IF ( .NOT. BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &2506 BTEST( wall_flags_ 0(k+1,j,i), 0 ) ) &2507 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )2508 IF ( .NOT. BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 2509 BTEST( wall_flags_static_0(k+1,j,i), 0 ) ) & 2510 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 12 ) 2508 2511 ! 2509 2512 !-- Upward facing wall on u grid 2510 IF ( .NOT. BTEST( wall_flags_ 0(k,j,i), 1 ) .AND. &2511 BTEST( wall_flags_ 0(k+1,j,i), 1 ) ) &2512 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 14 )2513 IF ( .NOT. BTEST( wall_flags_static_0(k,j,i), 1 ) .AND. & 2514 BTEST( wall_flags_static_0(k+1,j,i), 1 ) ) & 2515 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 14 ) 2513 2516 2514 2517 ! 2515 2518 !-- Upward facing wall on v grid 2516 IF ( .NOT. BTEST( wall_flags_ 0(k,j,i), 2 ) .AND. &2517 BTEST( wall_flags_ 0(k+1,j,i), 2 ) ) &2518 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 16 )2519 IF ( .NOT. BTEST( wall_flags_static_0(k,j,i), 2 ) .AND. & 2520 BTEST( wall_flags_static_0(k+1,j,i), 2 ) ) & 2521 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 16 ) 2519 2522 2520 2523 ! 2521 2524 !-- Upward facing wall on w grid 2522 IF ( .NOT. BTEST( wall_flags_ 0(k,j,i), 3 ) .AND. &2523 BTEST( wall_flags_ 0(k+1,j,i), 3 ) ) &2524 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )2525 IF ( .NOT. BTEST( wall_flags_static_0(k,j,i), 3 ) .AND. & 2526 BTEST( wall_flags_static_0(k+1,j,i), 3 ) ) & 2527 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 18 ) 2525 2528 ! 2526 2529 !-- Special flag on scalar grid, former nzb_s_inner 2527 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) .OR. &2528 BTEST( wall_flags_ 0(k,j,i), 12 ) .OR. &2529 BTEST( wall_flags_ 0(k,j,i), 13 ) ) &2530 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 22 )2530 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) .OR. & 2531 BTEST( wall_flags_static_0(k,j,i), 12 ) .OR. & 2532 BTEST( wall_flags_static_0(k,j,i), 13 ) ) & 2533 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 22 ) 2531 2534 ! 2532 2535 !-- Special flag on scalar grid, nzb_diff_s_inner - 1, required for 2533 2536 !-- flow_statistics 2534 2537 IF ( constant_flux_layer .OR. use_surface_fluxes ) THEN 2535 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. &2536 BTEST( wall_flags_ 0(k+1,j,i), 0 ) ) &2537 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )2538 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. & 2539 BTEST( wall_flags_static_0(k+1,j,i), 0 ) ) & 2540 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 23 ) 2538 2541 ELSE 2539 IF ( BTEST( wall_flags_ 0(k,j,i), 22 ) ) &2540 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )2542 IF ( BTEST( wall_flags_static_0(k,j,i), 22 ) ) & 2543 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 23 ) 2541 2544 ENDIF 2542 2545 2543 2546 2544 2547 ENDDO 2545 wall_flags_ 0(nzt+1,j,i) = IBSET( wall_flags_0(nzt+1,j,i), 22 )2546 wall_flags_ 0(nzt+1,j,i) = IBSET( wall_flags_0(nzt+1,j,i), 23 )2548 wall_flags_static_0(nzt+1,j,i) = IBSET( wall_flags_static_0(nzt+1,j,i), 22 ) 2549 wall_flags_static_0(nzt+1,j,i) = IBSET( wall_flags_static_0(nzt+1,j,i), 23 ) 2547 2550 ! 2548 2551 !-- Set flags indicating that topography is close by in horizontal … … 2555 2558 IF ( scalar_advec == 'ws-scheme' ) THEN 2556 2559 DO k = nzb, nzt 2557 IF ( BTEST( wall_flags_ 0(k,j,i), 0 ) .AND. ( &2558 ANY( .NOT. BTEST( wall_flags_ 0(k,j-3:j+3,i-1), 0 ) ) .OR.&2559 ANY( .NOT. BTEST( wall_flags_ 0(k,j-3:j+3,i-2), 0 ) ) .OR.&2560 ANY( .NOT. BTEST( wall_flags_ 0(k,j-3:j+3,i-3), 0 ) ) .OR.&2561 ANY( .NOT. BTEST( wall_flags_ 0(k,j-3:j+3,i+1), 0 ) ) .OR.&2562 ANY( .NOT. BTEST( wall_flags_ 0(k,j-3:j+3,i+2), 0 ) ) .OR.&2563 ANY( .NOT. BTEST( wall_flags_ 0(k,j-3:j+3,i+3), 0 ) ) .OR.&2564 ANY( .NOT. BTEST( wall_flags_ 0(k,j-1,i-3:i+3), 0 ) ) .OR.&2565 ANY( .NOT. BTEST( wall_flags_ 0(k,j-2,i-3:i+3), 0 ) ) .OR.&2566 ANY( .NOT. BTEST( wall_flags_ 0(k,j-3,i-3:i+3), 0 ) ) .OR.&2567 ANY( .NOT. BTEST( wall_flags_ 0(k,j+1,i-3:i+3), 0 ) ) .OR.&2568 ANY( .NOT. BTEST( wall_flags_ 0(k,j+2,i-3:i+3), 0 ) ) .OR.&2569 ANY( .NOT. BTEST( wall_flags_ 0(k,j+3,i-3:i+3), 0 ) ) &2560 IF ( BTEST( wall_flags_static_0(k,j,i), 0 ) .AND. ( & 2561 ANY( .NOT. BTEST( wall_flags_static_0(k,j-3:j+3,i-1), 0 ) ) .OR.& 2562 ANY( .NOT. BTEST( wall_flags_static_0(k,j-3:j+3,i-2), 0 ) ) .OR.& 2563 ANY( .NOT. BTEST( wall_flags_static_0(k,j-3:j+3,i-3), 0 ) ) .OR.& 2564 ANY( .NOT. BTEST( wall_flags_static_0(k,j-3:j+3,i+1), 0 ) ) .OR.& 2565 ANY( .NOT. BTEST( wall_flags_static_0(k,j-3:j+3,i+2), 0 ) ) .OR.& 2566 ANY( .NOT. BTEST( wall_flags_static_0(k,j-3:j+3,i+3), 0 ) ) .OR.& 2567 ANY( .NOT. BTEST( wall_flags_static_0(k,j-1,i-3:i+3), 0 ) ) .OR.& 2568 ANY( .NOT. BTEST( wall_flags_static_0(k,j-2,i-3:i+3), 0 ) ) .OR.& 2569 ANY( .NOT. BTEST( wall_flags_static_0(k,j-3,i-3:i+3), 0 ) ) .OR.& 2570 ANY( .NOT. BTEST( wall_flags_static_0(k,j+1,i-3:i+3), 0 ) ) .OR.& 2571 ANY( .NOT. BTEST( wall_flags_static_0(k,j+2,i-3:i+3), 0 ) ) .OR.& 2572 ANY( .NOT. BTEST( wall_flags_static_0(k,j+3,i-3:i+3), 0 ) ) & 2570 2573 ) ) & 2571 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 31 )2574 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 31 ) 2572 2575 2573 2576 ENDDO … … 2585 2588 !-- If no topography is initialized, the land-surface is at k = nzb. 2586 2589 IF ( TRIM( topography ) /= 'read_from_file' ) THEN 2587 wall_flags_ 0(nzb,:,:) = IBSET( wall_flags_0(nzb,:,:), 5 )2590 wall_flags_static_0(nzb,:,:) = IBSET( wall_flags_static_0(nzb,:,:), 5 ) 2588 2591 ELSE 2589 2592 DO i = nxl, nxr … … 2593 2596 !-- Natural terrain grid point 2594 2597 IF ( BTEST( topo(k,j,i), 1 ) ) & 2595 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 5 )2598 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 5 ) 2596 2599 ENDDO 2597 2600 ENDDO … … 2604 2607 DO k = nzb, nzt+1 2605 2608 IF ( BTEST( topo(k,j,i), 2 ) ) & 2606 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 6 )2609 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 6 ) 2607 2610 ENDDO 2608 2611 ENDDO … … 2614 2617 DO k = nzb, nzt+1 2615 2618 IF ( BTEST( topo(k,j,i), 4 ) ) & 2616 wall_flags_ 0(k,j,i) = IBSET( wall_flags_0(k,j,i), 4 )2619 wall_flags_static_0(k,j,i) = IBSET( wall_flags_static_0(k,j,i), 4 ) 2617 2620 ENDDO 2618 2621 ENDDO … … 2620 2623 ! 2621 2624 !-- Exchange ghost points for wall flags 2622 CALL exchange_horiz_int( wall_flags_ 0, nys, nyn, nxl, nxr, nzt, nbgp )2625 CALL exchange_horiz_int( wall_flags_static_0, nys, nyn, nxl, nxr, nzt, nbgp ) 2623 2626 ! 2624 2627 !-- Set boundary conditions also for flags. Can be interpreted as Neumann … … 2627 2630 IF ( nys == 0 ) THEN 2628 2631 DO i = 1, nbgp 2629 wall_flags_ 0(:,nys-i,:) = wall_flags_0(:,nys,:)2632 wall_flags_static_0(:,nys-i,:) = wall_flags_static_0(:,nys,:) 2630 2633 ENDDO 2631 2634 ENDIF 2632 2635 IF ( nyn == ny ) THEN 2633 2636 DO i = 1, nbgp 2634 wall_flags_ 0(:,nyn+i,:) = wall_flags_0(:,nyn,:)2637 wall_flags_static_0(:,nyn+i,:) = wall_flags_static_0(:,nyn,:) 2635 2638 ENDDO 2636 2639 ENDIF … … 2639 2642 IF ( nxl == 0 ) THEN 2640 2643 DO i = 1, nbgp 2641 wall_flags_ 0(:,:,nxl-i) = wall_flags_0(:,:,nxl)2644 wall_flags_static_0(:,:,nxl-i) = wall_flags_static_0(:,:,nxl) 2642 2645 ENDDO 2643 2646 ENDIF 2644 2647 IF ( nxr == nx ) THEN 2645 2648 DO i = 1, nbgp 2646 wall_flags_ 0(:,:,nxr+i) = wall_flags_0(:,:,nxr)2649 wall_flags_static_0(:,:,nxr+i) = wall_flags_static_0(:,:,nxr) 2647 2650 ENDDO 2648 2651 ENDIF … … 2657 2660 topo_top_ind(:,:,0) = MAXLOC( & 2658 2661 MERGE( 1, 0, & 2659 BTEST( wall_flags_ 0(:,:,:), ibit ) &2662 BTEST( wall_flags_static_0(:,:,:), ibit ) & 2660 2663 ), DIM = 1 & 2661 2664 ) - 1 … … 2665 2668 topo_top_ind(:,:,1) = MAXLOC( & 2666 2669 MERGE( 1, 0, & 2667 BTEST( wall_flags_ 0(:,:,:), ibit ) &2670 BTEST( wall_flags_static_0(:,:,:), ibit ) & 2668 2671 ), DIM = 1 & 2669 2672 ) - 1 … … 2673 2676 topo_top_ind(:,:,2) = MAXLOC( & 2674 2677 MERGE( 1, 0, & 2675 BTEST( wall_flags_ 0(:,:,:), ibit ) &2678 BTEST( wall_flags_static_0(:,:,:), ibit ) & 2676 2679 ), DIM = 1 & 2677 2680 ) - 1 … … 2681 2684 topo_top_ind(:,:,3) = MAXLOC( & 2682 2685 MERGE( 1, 0, & 2683 BTEST( wall_flags_ 0(:,:,:), ibit ) &2686 BTEST( wall_flags_static_0(:,:,:), ibit ) & 2684 2687 ), DIM = 1 & 2685 2688 ) - 1 … … 2689 2692 topo_top_ind(:,:,4) = MAXLOC( & 2690 2693 MERGE( 1, 0, & 2691 BTEST( wall_flags_ 0(:,:,:), ibit ) &2694 BTEST( wall_flags_static_0(:,:,:), ibit ) & 2692 2695 ), DIM = 1 & 2693 2696 ) - 1
Note: See TracChangeset
for help on using the changeset viewer.