Changeset 2311 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Jul 13, 2017 1:34:42 PM (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2293 r2311 26 26 ! ----------------- 27 27 ! $Id$ 28 ! Set bottom boundary condition after anterpolation. 29 ! Some variable description added. 30 ! 31 ! 2293 2017-06-22 12:59:12Z suehring 28 32 ! In anterpolation, exclude grid points which are used for interpolation. 29 33 ! This avoids the accumulation of numerical errors leading to increased … … 422 426 TYPE(coarsegrid_def), SAVE :: cg !: 423 427 428 INTERFACE pmci_boundary_conds 429 MODULE PROCEDURE pmci_boundary_conds 430 END INTERFACE pmci_boundary_conds 424 431 425 432 INTERFACE pmci_check_setting_mismatches … … 464 471 cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode, & 465 472 parent_to_child 473 474 PUBLIC pmci_boundary_conds 466 475 PUBLIC pmci_child_initialize 467 476 PUBLIC pmci_datatrans … … 4482 4491 IF ( .NOT. neutral ) THEN 4483 4492 CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo, & 4484 kfuo, ijfc_s, kfc_s, ' s' )4493 kfuo, ijfc_s, kfc_s, 'pt' ) 4485 4494 ENDIF 4486 4495 … … 4488 4497 4489 4498 CALL pmci_anterp_tophat( q, q_c, kctu, iflo, ifuo, jflo, jfuo, kflo, & 4490 kfuo, ijfc_s, kfc_s, ' s' )4499 kfuo, ijfc_s, kfc_s, 'q' ) 4491 4500 4492 4501 IF ( cloud_physics .AND. microphysics_morrison ) THEN 4493 4502 4494 4503 CALL pmci_anterp_tophat( qc, qcc, kctu, iflo, ifuo, jflo, jfuo, & 4495 kflo, kfuo, ijfc_s, kfc_s, ' s' )4504 kflo, kfuo, ijfc_s, kfc_s, 'qc' ) 4496 4505 4497 4506 CALL pmci_anterp_tophat( nc, ncc, kctu, iflo, ifuo, jflo, jfuo, & 4498 kflo, kfuo, ijfc_s, kfc_s, ' s' )4507 kflo, kfuo, ijfc_s, kfc_s, 'nc' ) 4499 4508 4500 4509 ENDIF … … 4503 4512 4504 4513 CALL pmci_anterp_tophat( qr, qrc, kctu, iflo, ifuo, jflo, jfuo, & 4505 kflo, kfuo, ijfc_s, kfc_s, ' s' )4514 kflo, kfuo, ijfc_s, kfc_s, 'qr' ) 4506 4515 4507 4516 CALL pmci_anterp_tophat( nr, nrc, kctu, iflo, ifuo, jflo, jfuo, & 4508 kflo, kfuo, ijfc_s, kfc_s, ' s' )4517 kflo, kfuo, ijfc_s, kfc_s, 'nr' ) 4509 4518 4510 4519 ENDIF … … 5382 5391 IMPLICIT NONE 5383 5392 5384 CHARACTER(LEN= 1), INTENT(IN) :: var !:5385 5386 INTEGER(iwp) :: i ! : Fine-grid index5387 INTEGER(iwp) :: ii ! : Coarse-grid index5388 INTEGER(iwp) :: iclp ! :5389 INTEGER(iwp) :: icrm ! :5390 INTEGER(iwp) :: j ! : Fine-grid index5391 INTEGER(iwp) :: jj ! : Coarse-grid index5392 INTEGER(iwp) :: jcnm ! :5393 INTEGER(iwp) :: jcsp ! :5394 INTEGER(iwp) :: k ! : Fine-grid index5395 INTEGER(iwp) :: kk ! : Coarse-grid index5396 INTEGER(iwp) :: kcb = 0 ! :5397 INTEGER(iwp) :: nfc !:5398 5399 INTEGER(iwp), INTENT(IN) :: kct !: 5400 5401 INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) :: ifl !: 5402 INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) :: if u !:5403 INTEGER(iwp), DIMENSION( jcs:jcn,icl:icr), INTENT(IN) :: ijfc !:5404 INTEGER(iwp), DIMENSION(jcs:jcn ), INTENT(IN) :: jfl !:5405 INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) :: jf u !:5406 INTEGER(iwp), DIMENSION( 0:kct), INTENT(IN) :: kfc !:5407 INTEGER(iwp), DIMENSION(0:kct), INTENT(IN) :: kf l !:5408 INTEGER(iwp), DIMENSION(0:kct), INTENT(IN) :: kf u !:5409 5410 REAL(wp) :: cellsum !: 5411 REAL(wp) :: f1f !:5412 REAL(wp) :: fra ! :5413 5414 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) :: f ! :5415 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT) :: fc ! :5393 CHARACTER(LEN=*), INTENT(IN) :: var !< identifyer for treated variable 5394 5395 INTEGER(iwp) :: i !< Running index x-direction - fine-grid 5396 INTEGER(iwp) :: ii !< Running index x-direction - coarse grid 5397 INTEGER(iwp) :: iclp !< Left boundary index for anterpolation along x 5398 INTEGER(iwp) :: icrm !< Right boundary index for anterpolation along x 5399 INTEGER(iwp) :: j !< Running index y-direction - fine-grid 5400 INTEGER(iwp) :: jj !< Running index y-direction - coarse grid 5401 INTEGER(iwp) :: jcnm !< North boundary index for anterpolation along y 5402 INTEGER(iwp) :: jcsp !< South boundary index for anterpolation along y 5403 INTEGER(iwp) :: k !< Running index z-direction - fine-grid 5404 INTEGER(iwp) :: kk !< Running index z-direction - coarse grid 5405 INTEGER(iwp) :: kcb = 0 !< Bottom boundary index for anterpolation along z 5406 INTEGER(iwp) :: m !< Running index surface type 5407 INTEGER(iwp) :: nfc !< 5408 5409 INTEGER(iwp), INTENT(IN) :: kct !< Top boundary index for anterpolation along z 5410 5411 INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) :: ifl !< Indicates start index of child cells belonging to certain parent cell - x direction 5412 INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) :: ifu !< Indicates end index of child cells belonging to certain parent cell - x direction 5413 INTEGER(iwp), DIMENSION(jcs:jcn,icl:icr), INTENT(IN) :: ijfc !< 5414 INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) :: jfl !< Indicates start index of child cells belonging to certain parent cell - y direction 5415 INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) :: jfu !< Indicates start index of child cells belonging to certain parent cell - y direction 5416 INTEGER(iwp), DIMENSION(0:kct), INTENT(IN) :: kfc !< 5417 INTEGER(iwp), DIMENSION(0:kct), INTENT(IN) :: kfl !< Indicates start index of child cells belonging to certain parent cell - z direction 5418 INTEGER(iwp), DIMENSION(0:kct), INTENT(IN) :: kfu !< Indicates start index of child cells belonging to certain parent cell - z direction 5419 5420 REAL(wp) :: cellsum !< sum of respective child cells belonging to parent cell 5421 REAL(wp) :: fra !< relaxation faction 5422 5423 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) :: f !< Treated variable - child domain 5424 REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT) :: fc !< Treated variable - parent domain 5416 5425 5417 5426 … … 5501 5510 ENDDO 5502 5511 5512 5503 5513 END SUBROUTINE pmci_anterp_tophat 5504 5514 5505 5515 #endif 5516 5506 5517 END SUBROUTINE pmci_child_datatrans 5507 5518 5519 ! Description: 5520 ! ------------ 5521 !> Set boundary conditions for the prognostic quantities after interpolation 5522 !> and anterpolation at upward- and downward facing surfaces. 5523 !> @todo: add Dirichlet boundary conditions for pot. temperature, humdidity and 5524 !> passive scalar. 5525 !------------------------------------------------------------------------------! 5526 SUBROUTINE pmci_boundary_conds 5527 5528 USE control_parameters, & 5529 ONLY: ibc_pt_b, ibc_q_b, ibc_s_b, ibc_uv_b 5530 5531 USE surface_mod, & 5532 ONLY: bc_h 5533 5534 IMPLICIT NONE 5535 5536 INTEGER(iwp) :: i !< Index along x-direction 5537 INTEGER(iwp) :: j !< Index along y-direction 5538 INTEGER(iwp) :: k !< Index along z-direction 5539 INTEGER(iwp) :: m !< Running index for surface type 5540 5541 ! 5542 !-- Set Dirichlet boundary conditions for horizontal velocity components 5543 IF ( ibc_uv_b == 0 ) THEN 5544 ! 5545 !-- Upward-facing surfaces 5546 DO m = 1, bc_h(0)%ns 5547 i = bc_h(0)%i(m) 5548 j = bc_h(0)%j(m) 5549 k = bc_h(0)%k(m) 5550 u(k-1,j,i) = 0.0_wp 5551 v(k-1,j,i) = 0.0_wp 5552 ENDDO 5553 ! 5554 !-- Downward-facing surfaces 5555 DO m = 1, bc_h(1)%ns 5556 i = bc_h(1)%i(m) 5557 j = bc_h(1)%j(m) 5558 k = bc_h(1)%k(m) 5559 u(k+1,j,i) = 0.0_wp 5560 v(k+1,j,i) = 0.0_wp 5561 ENDDO 5562 ENDIF 5563 ! 5564 !-- Set Dirichlet boundary conditions for vertical velocity component 5565 !-- Upward-facing surfaces 5566 DO m = 1, bc_h(0)%ns 5567 i = bc_h(0)%i(m) 5568 j = bc_h(0)%j(m) 5569 k = bc_h(0)%k(m) 5570 w(k-1,j,i) = 0.0_wp 5571 ENDDO 5572 ! 5573 !-- Downward-facing surfaces 5574 DO m = 1, bc_h(1)%ns 5575 i = bc_h(1)%i(m) 5576 j = bc_h(1)%j(m) 5577 k = bc_h(1)%k(m) 5578 w(k+1,j,i) = 0.0_wp 5579 ENDDO 5580 ! 5581 !-- Set Neumann boundary conditions for potential temperature 5582 IF ( .NOT. neutral ) THEN 5583 IF ( ibc_pt_b == 1 ) THEN 5584 DO m = 1, bc_h(0)%ns 5585 i = bc_h(0)%i(m) 5586 j = bc_h(0)%j(m) 5587 k = bc_h(0)%k(m) 5588 pt(k-1,j,i) = pt(k,j,i) 5589 ENDDO 5590 DO m = 1, bc_h(1)%ns 5591 i = bc_h(1)%i(m) 5592 j = bc_h(1)%j(m) 5593 k = bc_h(1)%k(m) 5594 pt(k+1,j,i) = pt(k,j,i) 5595 ENDDO 5596 ENDIF 5597 ENDIF 5598 5599 ! 5600 !-- Set Neumann boundary conditions for humidity and cloud-physical quantities 5601 IF ( humidity ) THEN 5602 IF ( ibc_q_b == 1 ) THEN 5603 DO m = 1, bc_h(0)%ns 5604 i = bc_h(0)%i(m) 5605 j = bc_h(0)%j(m) 5606 k = bc_h(0)%k(m) 5607 q(k-1,j,i) = q(k,j,i) 5608 ENDDO 5609 DO m = 1, bc_h(1)%ns 5610 i = bc_h(1)%i(m) 5611 j = bc_h(1)%j(m) 5612 k = bc_h(1)%k(m) 5613 q(k+1,j,i) = q(k,j,i) 5614 ENDDO 5615 ENDIF 5616 IF ( cloud_physics .AND. microphysics_morrison ) THEN 5617 DO m = 1, bc_h(0)%ns 5618 i = bc_h(0)%i(m) 5619 j = bc_h(0)%j(m) 5620 k = bc_h(0)%k(m) 5621 nc(k-1,j,i) = 0.0_wp 5622 qc(k-1,j,i) = 0.0_wp 5623 ENDDO 5624 DO m = 1, bc_h(1)%ns 5625 i = bc_h(1)%i(m) 5626 j = bc_h(1)%j(m) 5627 k = bc_h(1)%k(m) 5628 5629 nc(k+1,j,i) = 0.0_wp 5630 qc(k+1,j,i) = 0.0_wp 5631 ENDDO 5632 ENDIF 5633 5634 IF ( cloud_physics .AND. microphysics_seifert ) THEN 5635 DO m = 1, bc_h(0)%ns 5636 i = bc_h(0)%i(m) 5637 j = bc_h(0)%j(m) 5638 k = bc_h(0)%k(m) 5639 nr(k-1,j,i) = 0.0_wp 5640 qr(k-1,j,i) = 0.0_wp 5641 ENDDO 5642 DO m = 1, bc_h(1)%ns 5643 i = bc_h(1)%i(m) 5644 j = bc_h(1)%j(m) 5645 k = bc_h(1)%k(m) 5646 nr(k+1,j,i) = 0.0_wp 5647 qr(k+1,j,i) = 0.0_wp 5648 ENDDO 5649 ENDIF 5650 5651 ENDIF 5652 ! 5653 !-- Set Neumann boundary conditions for passive scalar 5654 IF ( passive_scalar ) THEN 5655 IF ( ibc_s_b == 1 ) THEN 5656 DO m = 1, bc_h(0)%ns 5657 i = bc_h(0)%i(m) 5658 j = bc_h(0)%j(m) 5659 k = bc_h(0)%k(m) 5660 s(k-1,j,i) = s(k,j,i) 5661 ENDDO 5662 DO m = 1, bc_h(1)%ns 5663 i = bc_h(1)%i(m) 5664 j = bc_h(1)%j(m) 5665 k = bc_h(1)%k(m) 5666 s(k-1,j,i) = s(k,j,i) 5667 ENDDO 5668 ENDIF 5669 ENDIF 5670 5671 END SUBROUTINE pmci_boundary_conds 5672 5508 5673 END MODULE pmc_interface
Note: See TracChangeset
for help on using the changeset viewer.