Changeset 2868 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Mar 9, 2018 1:25:09 PM (7 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2853 r2868 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Local conditional Neumann conditions for one-way coupling removed. 28 ! 29 ! 2853 2018-03-05 14:44:20Z suehring 27 30 ! Bugfix in init log-law correction. 28 31 ! … … 4074 4077 BTEST( wall_flags_0(k,j,i), 3 ) ) 4075 4078 ! 4076 !-- TO_DO: zero setting of temperature within topography creates4079 !-- TO_DO: zero setting of temperature within topography creates 4077 4080 !-- wrong results 4078 4081 ! pt(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp … … 4252 4255 ENDIF 4253 4256 4254 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN4255 CALL pmci_extrap_ifoutflow_lr( u, 'l', 'u' )4256 CALL pmci_extrap_ifoutflow_lr( v, 'l', 'v' )4257 CALL pmci_extrap_ifoutflow_lr( w, 'l', 'w' )4258 CALL pmci_extrap_ifoutflow_lr( e, 'l', 'e' )4259 4260 IF ( .NOT. neutral ) THEN4261 CALL pmci_extrap_ifoutflow_lr( pt, 'l', 's' )4262 ENDIF4263 4264 IF ( humidity ) THEN4265 CALL pmci_extrap_ifoutflow_lr( q, 'l', 's' )4266 4267 IF ( cloud_physics .AND. microphysics_morrison ) THEN4268 4269 CALL pmci_extrap_ifoutflow_lr( qc, 'l', 's' )4270 CALL pmci_extrap_ifoutflow_lr( nc, 'l', 's' )4271 4272 ENDIF4273 4274 IF ( cloud_physics .AND. microphysics_seifert ) THEN4275 4276 CALL pmci_extrap_ifoutflow_lr( qr, 'l', 's' )4277 CALL pmci_extrap_ifoutflow_lr( nr, 'l', 's' )4278 4279 ENDIF4280 4281 ENDIF4282 4283 IF ( passive_scalar ) THEN4284 CALL pmci_extrap_ifoutflow_lr( s, 'l', 's' )4285 ENDIF4286 4287 IF ( air_chemistry ) THEN4288 DO n = 1, nspec4289 CALL pmci_extrap_ifoutflow_lr( chem_species(n)%conc, &4290 'l', 's' )4291 ENDDO4292 ENDIF4293 4294 ENDIF4295 4296 4257 ENDIF 4297 4258 ! … … 4381 4342 logc_kbounds_w_r, & 4382 4343 nzt_topo_nestbc_r, 'r', 's' ) 4344 ENDIF 4383 4345 4384 4346 IF ( air_chemistry ) THEN … … 4392 4354 nzt_topo_nestbc_r, 'r', 's' ) 4393 4355 ENDDO 4394 ENDIF4395 4396 ENDIF4397 4398 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN4399 CALL pmci_extrap_ifoutflow_lr( u, 'r', 'u' )4400 CALL pmci_extrap_ifoutflow_lr( v, 'r', 'v' )4401 CALL pmci_extrap_ifoutflow_lr( w, 'r', 'w' )4402 CALL pmci_extrap_ifoutflow_lr( e, 'r', 'e' )4403 4404 IF ( .NOT. neutral ) THEN4405 CALL pmci_extrap_ifoutflow_lr( pt, 'r', 's' )4406 ENDIF4407 4408 IF ( humidity ) THEN4409 CALL pmci_extrap_ifoutflow_lr( q, 'r', 's' )4410 4411 IF ( cloud_physics .AND. microphysics_morrison ) THEN4412 CALL pmci_extrap_ifoutflow_lr( qc, 'r', 's' )4413 CALL pmci_extrap_ifoutflow_lr( nc, 'r', 's' )4414 ENDIF4415 4416 IF ( cloud_physics .AND. microphysics_seifert ) THEN4417 CALL pmci_extrap_ifoutflow_lr( qr, 'r', 's' )4418 CALL pmci_extrap_ifoutflow_lr( nr, 'r', 's' )4419 ENDIF4420 4421 ENDIF4422 4423 IF ( passive_scalar ) THEN4424 CALL pmci_extrap_ifoutflow_lr( s, 'r', 's' )4425 ENDIF4426 4427 IF ( air_chemistry ) THEN4428 DO n = 1, nspec4429 CALL pmci_extrap_ifoutflow_lr( chem_species(n)%conc, &4430 'r', 's' )4431 ENDDO4432 ENDIF4433 4356 ENDIF 4434 4357 … … 4527 4450 ENDIF 4528 4451 4529 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN4530 CALL pmci_extrap_ifoutflow_sn( u, 's', 'u' )4531 CALL pmci_extrap_ifoutflow_sn( v, 's', 'v' )4532 CALL pmci_extrap_ifoutflow_sn( w, 's', 'w' )4533 CALL pmci_extrap_ifoutflow_sn( e, 's', 'e' )4534 4535 IF ( .NOT. neutral ) THEN4536 CALL pmci_extrap_ifoutflow_sn( pt, 's', 's' )4537 ENDIF4538 4539 IF ( humidity ) THEN4540 CALL pmci_extrap_ifoutflow_sn( q, 's', 's' )4541 4542 IF ( cloud_physics .AND. microphysics_morrison ) THEN4543 CALL pmci_extrap_ifoutflow_sn( qc, 's', 's' )4544 CALL pmci_extrap_ifoutflow_sn( nc, 's', 's' )4545 ENDIF4546 4547 IF ( cloud_physics .AND. microphysics_seifert ) THEN4548 CALL pmci_extrap_ifoutflow_sn( qr, 's', 's' )4549 CALL pmci_extrap_ifoutflow_sn( nr, 's', 's' )4550 4551 ENDIF4552 4553 ENDIF4554 4555 IF ( passive_scalar ) THEN4556 CALL pmci_extrap_ifoutflow_sn( s, 's', 's' )4557 ENDIF4558 4559 IF ( air_chemistry ) THEN4560 DO n = 1, nspec4561 CALL pmci_extrap_ifoutflow_sn( chem_species(n)%conc, &4562 's', 's' )4563 ENDDO4564 ENDIF4565 4566 ENDIF4567 4568 4452 ENDIF 4569 4453 ! … … 4662 4546 ENDDO 4663 4547 ENDIF 4664 4665 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 4666 CALL pmci_extrap_ifoutflow_sn( u, 'n', 'u' ) 4667 CALL pmci_extrap_ifoutflow_sn( v, 'n', 'v' ) 4668 CALL pmci_extrap_ifoutflow_sn( w, 'n', 'w' ) 4669 CALL pmci_extrap_ifoutflow_sn( e, 'n', 'e' ) 4670 4671 IF ( .NOT. neutral ) THEN 4672 CALL pmci_extrap_ifoutflow_sn( pt, 'n', 's' ) 4673 ENDIF 4674 4675 IF ( humidity ) THEN 4676 CALL pmci_extrap_ifoutflow_sn( q, 'n', 's' ) 4677 4678 IF ( cloud_physics .AND. microphysics_seifert ) THEN 4679 CALL pmci_extrap_ifoutflow_sn( qc, 'n', 's' ) 4680 CALL pmci_extrap_ifoutflow_sn( nc, 'n', 's' ) 4681 ENDIF 4682 4683 IF ( cloud_physics .AND. microphysics_seifert ) THEN 4684 CALL pmci_extrap_ifoutflow_sn( qr, 'n', 's' ) 4685 CALL pmci_extrap_ifoutflow_sn( nr, 'n', 's' ) 4686 ENDIF 4687 4688 ENDIF 4689 4690 IF ( passive_scalar ) THEN 4691 CALL pmci_extrap_ifoutflow_sn( s, 'n', 's' ) 4692 ENDIF 4693 4694 IF ( air_chemistry ) THEN 4695 DO n = 1, nspec 4696 CALL pmci_extrap_ifoutflow_sn( chem_species(n)%conc, & 4697 'n', 's' ) 4698 ENDDO 4699 ENDIF 4700 4701 ENDIF 4702 4548 4703 4549 ENDIF 4704 4550 … … 4762 4608 ENDDO 4763 4609 ENDIF 4764 4765 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 4766 4767 CALL pmci_extrap_ifoutflow_t( u, 'u' ) 4768 CALL pmci_extrap_ifoutflow_t( v, 'v' ) 4769 CALL pmci_extrap_ifoutflow_t( w, 'w' ) 4770 CALL pmci_extrap_ifoutflow_t( e, 'e' ) 4771 4772 IF ( .NOT. neutral ) THEN 4773 CALL pmci_extrap_ifoutflow_t( pt, 's' ) 4774 ENDIF 4775 4776 IF ( humidity ) THEN 4777 4778 CALL pmci_extrap_ifoutflow_t( q, 's' ) 4779 4780 IF ( cloud_physics .AND. microphysics_morrison ) THEN 4781 CALL pmci_extrap_ifoutflow_t( qc, 's' ) 4782 CALL pmci_extrap_ifoutflow_t( nc, 's' ) 4783 ENDIF 4784 4785 IF ( cloud_physics .AND. microphysics_seifert ) THEN 4786 CALL pmci_extrap_ifoutflow_t( qr, 's' ) 4787 CALL pmci_extrap_ifoutflow_t( nr, 's' ) 4788 4789 ENDIF 4790 4791 ENDIF 4792 4793 IF ( passive_scalar ) THEN 4794 CALL pmci_extrap_ifoutflow_t( s, 's' ) 4795 ENDIF 4796 4797 IF ( air_chemistry ) THEN 4798 DO n = 1, nspec 4799 CALL pmci_extrap_ifoutflow_t( chem_species(n)%conc, 's' ) 4800 ENDDO 4801 ENDIF 4802 4803 ENDIF 4804 4610 4805 4611 END SUBROUTINE pmci_interpolation 4806 4612 … … 5413 5219 ENDIF 5414 5220 5415 END SUBROUTINE pmci_interp_tril_t 5416 5417 5418 5419 SUBROUTINE pmci_extrap_ifoutflow_lr( f, edge, var ) 5420 ! 5421 !-- After the interpolation of ghost-node values for the child-domain 5422 !-- boundary conditions, this subroutine checks if there is a local outflow 5423 !-- through the boundary. In that case this subroutine overwrites the 5424 !-- interpolated values by values extrapolated from the domain. This 5425 !-- subroutine handles the left and right boundaries. However, this operation 5426 !-- is only needed in case of one-way coupling. 5427 5428 IMPLICIT NONE 5429 5430 CHARACTER(LEN=1), INTENT(IN) :: edge !< 5431 CHARACTER(LEN=1), INTENT(IN) :: var !< 5432 5433 INTEGER(iwp) :: i !< 5434 INTEGER(iwp) :: ib !< 5435 INTEGER(iwp) :: ibgp !< 5436 INTEGER(iwp) :: ied !< 5437 INTEGER(iwp) :: j !< 5438 INTEGER(iwp) :: k !< 5439 INTEGER(iwp) :: k_wall !< 5440 5441 REAL(wp) :: outnor !< 5442 REAL(wp) :: vdotnor !< 5443 5444 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !< 5445 ! 5446 !-- Check which edge is to be handled: left or right 5447 IF ( edge == 'l' ) THEN 5448 IF ( var == 'u' ) THEN 5449 i = nxl 5450 ib = nxl - 1 5451 ied = nxl + 1 5452 ELSE 5453 i = nxl - 1 5454 ib = nxl - 2 5455 ied = nxl 5456 ENDIF 5457 outnor = -1.0_wp 5458 ELSEIF ( edge == 'r' ) THEN 5459 i = nxr + 1 5460 ib = nxr + 2 5461 ied = nxr 5462 outnor = 1.0_wp 5463 ENDIF 5464 5465 DO j = nys, nyn+1 5466 ! 5467 !-- Determine vertical index of topography top at grid point (j,i) 5468 k_wall = get_topography_top_index_ji( j, i, TRIM( var ) ) 5469 5470 DO k = k_wall, nzt+1 5471 vdotnor = outnor * u(k,j,ied) 5472 ! 5473 !-- Local outflow 5474 IF ( vdotnor > 0.0_wp ) THEN 5475 f(k,j,i) = f(k,j,ied) 5476 ENDIF 5477 ENDDO 5478 IF ( (var == 'u' ) .OR. (var == 'v' ) .OR. (var == 'w') ) THEN 5479 f(k_wall,j,i) = 0.0_wp 5480 ENDIF 5481 ENDDO 5482 ! 5483 !-- Store the boundary values also into the redundant ghost node layers. 5484 IF ( edge == 'l' ) THEN 5485 DO ibgp = -nbgp, ib 5486 f(0:nzt+1,nysg:nyng,ibgp) = f(0:nzt+1,nysg:nyng,i) 5487 ENDDO 5488 ELSEIF ( edge == 'r' ) THEN 5489 DO ibgp = ib, nx+nbgp 5490 f(0:nzt+1,nysg:nyng,ibgp) = f(0:nzt+1,nysg:nyng,i) 5491 ENDDO 5492 ENDIF 5493 5494 END SUBROUTINE pmci_extrap_ifoutflow_lr 5495 5496 5497 5498 SUBROUTINE pmci_extrap_ifoutflow_sn( f, edge, var ) 5499 ! 5500 !-- After the interpolation of ghost-node values for the child-domain 5501 !-- boundary conditions, this subroutine checks if there is a local outflow 5502 !-- through the boundary. In that case this subroutine overwrites the 5503 !-- interpolated values by values extrapolated from the domain. This 5504 !-- subroutine handles the south and north boundaries. 5505 5506 IMPLICIT NONE 5507 5508 CHARACTER(LEN=1), INTENT(IN) :: edge !< 5509 CHARACTER(LEN=1), INTENT(IN) :: var !< 5510 5511 INTEGER(iwp) :: i !< 5512 INTEGER(iwp) :: j !< 5513 INTEGER(iwp) :: jb !< 5514 INTEGER(iwp) :: jbgp !< 5515 INTEGER(iwp) :: jed !< 5516 INTEGER(iwp) :: k !< 5517 INTEGER(iwp) :: k_wall !< 5518 5519 REAL(wp) :: outnor !< 5520 REAL(wp) :: vdotnor !< 5521 5522 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !< 5523 5524 ! 5525 !-- Check which edge is to be handled: left or right 5526 IF ( edge == 's' ) THEN 5527 IF ( var == 'v' ) THEN 5528 j = nys 5529 jb = nys - 1 5530 jed = nys + 1 5531 ELSE 5532 j = nys - 1 5533 jb = nys - 2 5534 jed = nys 5535 ENDIF 5536 outnor = -1.0_wp 5537 ELSEIF ( edge == 'n' ) THEN 5538 j = nyn + 1 5539 jb = nyn + 2 5540 jed = nyn 5541 outnor = 1.0_wp 5542 ENDIF 5543 5544 DO i = nxl, nxr+1 5545 ! 5546 !-- Determine vertical index of topography top at grid point (j,i) 5547 k_wall = get_topography_top_index_ji( j, i, TRIM( var ) ) 5548 5549 DO k = k_wall, nzt+1 5550 vdotnor = outnor * v(k,jed,i) 5551 ! 5552 !-- Local outflow 5553 IF ( vdotnor > 0.0_wp ) THEN 5554 f(k,j,i) = f(k,jed,i) 5555 ENDIF 5556 ENDDO 5557 IF ( (var == 'u' ) .OR. (var == 'v' ) .OR. (var == 'w') ) THEN 5558 f(k_wall,j,i) = 0.0_wp 5559 ENDIF 5560 ENDDO 5561 ! 5562 !-- Store the boundary values also into the redundant ghost node layers. 5563 IF ( edge == 's' ) THEN 5564 DO jbgp = -nbgp, jb 5565 f(0:nzt+1,jbgp,nxlg:nxrg) = f(0:nzt+1,j,nxlg:nxrg) 5566 ENDDO 5567 ELSEIF ( edge == 'n' ) THEN 5568 DO jbgp = jb, ny+nbgp 5569 f(0:nzt+1,jbgp,nxlg:nxrg) = f(0:nzt+1,j,nxlg:nxrg) 5570 ENDDO 5571 ENDIF 5572 5573 END SUBROUTINE pmci_extrap_ifoutflow_sn 5574 5575 5576 5577 SUBROUTINE pmci_extrap_ifoutflow_t( f, var ) 5578 ! 5579 !-- Interpolation of ghost-node values used as the child-domain boundary 5580 !-- conditions. This subroutine handles the top boundary. It is based on 5581 !-- trilinear interpolation. 5582 5583 IMPLICIT NONE 5584 5585 CHARACTER(LEN=1), INTENT(IN) :: var !< 5586 5587 INTEGER(iwp) :: i !< 5588 INTEGER(iwp) :: j !< 5589 INTEGER(iwp) :: k !< 5590 INTEGER(iwp) :: ked !< 5591 5592 REAL(wp) :: vdotnor !< 5593 5594 REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp), & 5595 INTENT(INOUT) :: f !< 5596 5597 5598 IF ( var == 'w' ) THEN 5599 k = nzt 5600 ked = nzt - 1 5601 ELSE 5602 k = nzt + 1 5603 ked = nzt 5604 ENDIF 5605 5606 DO i = nxl, nxr 5607 DO j = nys, nyn 5608 vdotnor = w(ked,j,i) 5609 ! 5610 !-- Local outflow 5611 IF ( vdotnor > 0.0_wp ) THEN 5612 f(k,j,i) = f(ked,j,i) 5613 ENDIF 5614 ENDDO 5615 ENDDO 5616 ! 5617 !-- Just fill up the second ghost-node layer for w 5618 IF ( var == 'w' ) THEN 5619 f(nzt+1,:,:) = f(nzt,:,:) 5620 ENDIF 5621 5622 END SUBROUTINE pmci_extrap_ifoutflow_t 5221 END SUBROUTINE pmci_interp_tril_t 5623 5222 5624 5223
Note: See TracChangeset
for help on using the changeset viewer.
