Changeset 2868 for palm/trunk/SOURCE


Ignore:
Timestamp:
Mar 9, 2018 1:25:09 PM (7 years ago)
Author:
hellstea
Message:

Local conditional Neumann conditions for one-way coupling removed

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r2853 r2868  
    2525! -----------------
    2626! $Id$
     27! Local conditional Neumann conditions for one-way coupling removed. 
     28!
     29! 2853 2018-03-05 14:44:20Z suehring
    2730! Bugfix in init log-law correction.
    2831!
     
    40744077                                         BTEST( wall_flags_0(k,j,i), 3 ) )
    40754078!
    4076 !--                TO_DO: zero setting of temperature within topography creates
     4079!--                 TO_DO: zero setting of temperature within topography creates
    40774080!--                       wrong results
    40784081!                   pt(nzb:nzb_s_inner(j,i),j,i) = 0.0_wp
     
    42524255             ENDIF
    42534256
    4254              IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
    4255                 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 )  THEN
    4261                    CALL pmci_extrap_ifoutflow_lr( pt, 'l', 's' )
    4262                 ENDIF
    4263 
    4264                 IF ( humidity )  THEN
    4265                    CALL pmci_extrap_ifoutflow_lr( q, 'l', 's' )
    4266 
    4267                    IF ( cloud_physics  .AND.  microphysics_morrison )  THEN
    4268 
    4269                       CALL pmci_extrap_ifoutflow_lr( qc, 'l', 's' )
    4270                       CALL pmci_extrap_ifoutflow_lr( nc, 'l', 's' )
    4271 
    4272                    ENDIF
    4273 
    4274                    IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    4275 
    4276                       CALL pmci_extrap_ifoutflow_lr( qr, 'l', 's' )
    4277                       CALL pmci_extrap_ifoutflow_lr( nr, 'l', 's' )
    4278 
    4279                    ENDIF
    4280 
    4281                 ENDIF
    4282 
    4283                 IF ( passive_scalar )  THEN
    4284                    CALL pmci_extrap_ifoutflow_lr( s, 'l', 's' )
    4285                 ENDIF
    4286 
    4287                 IF ( air_chemistry )  THEN
    4288                    DO  n = 1, nspec
    4289                       CALL pmci_extrap_ifoutflow_lr( chem_species(n)%conc,     &
    4290                                                      'l', 's' )
    4291                    ENDDO
    4292                 ENDIF
    4293 
    4294              ENDIF
    4295 
    42964257          ENDIF
    42974258!
     
    43814342                                          logc_kbounds_w_r,                    &
    43824343                                          nzt_topo_nestbc_r, 'r', 's' )
     4344             ENDIF
    43834345
    43844346             IF ( air_chemistry )  THEN
     
    43924354                                             nzt_topo_nestbc_r, 'r', 's' )
    43934355                ENDDO
    4394              ENDIF
    4395 
    4396              ENDIF
    4397 
    4398              IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
    4399                 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 )  THEN
    4405                    CALL pmci_extrap_ifoutflow_lr( pt, 'r', 's' )
    4406                 ENDIF
    4407 
    4408                 IF ( humidity )  THEN
    4409                    CALL pmci_extrap_ifoutflow_lr( q, 'r', 's' )
    4410 
    4411                    IF ( cloud_physics  .AND.  microphysics_morrison )  THEN
    4412                       CALL pmci_extrap_ifoutflow_lr( qc, 'r', 's' )
    4413                       CALL pmci_extrap_ifoutflow_lr( nc, 'r', 's' ) 
    4414                    ENDIF
    4415 
    4416                    IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    4417                       CALL pmci_extrap_ifoutflow_lr( qr, 'r', 's' )
    4418                       CALL pmci_extrap_ifoutflow_lr( nr, 'r', 's' )
    4419                    ENDIF
    4420 
    4421                 ENDIF
    4422 
    4423                 IF ( passive_scalar )  THEN
    4424                    CALL pmci_extrap_ifoutflow_lr( s, 'r', 's' )
    4425                 ENDIF
    4426 
    4427                 IF ( air_chemistry )  THEN
    4428                    DO  n = 1, nspec
    4429                       CALL pmci_extrap_ifoutflow_lr( chem_species(n)%conc,     &
    4430                                                      'r', 's' )
    4431                    ENDDO
    4432                 ENDIF
    44334356             ENDIF
    44344357
     
    45274450             ENDIF
    45284451
    4529              IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
    4530                 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 )  THEN
    4536                    CALL pmci_extrap_ifoutflow_sn( pt, 's', 's' )
    4537                 ENDIF
    4538 
    4539                 IF ( humidity )  THEN
    4540                    CALL pmci_extrap_ifoutflow_sn( q,  's', 's' )
    4541 
    4542                    IF ( cloud_physics  .AND.  microphysics_morrison )  THEN
    4543                       CALL pmci_extrap_ifoutflow_sn( qc, 's', 's' )
    4544                       CALL pmci_extrap_ifoutflow_sn( nc, 's', 's' )
    4545                    ENDIF
    4546 
    4547                    IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    4548                       CALL pmci_extrap_ifoutflow_sn( qr, 's', 's' )     
    4549                       CALL pmci_extrap_ifoutflow_sn( nr, 's', 's' )
    4550 
    4551                    ENDIF
    4552 
    4553                 ENDIF
    4554 
    4555                 IF ( passive_scalar )  THEN
    4556                    CALL pmci_extrap_ifoutflow_sn( s,  's', 's' )
    4557                 ENDIF
    4558 
    4559                 IF ( air_chemistry )  THEN
    4560                    DO  n = 1, nspec
    4561                       CALL pmci_extrap_ifoutflow_sn( chem_species(n)%conc,     &
    4562                                                      's', 's' )
    4563                    ENDDO
    4564                 ENDIF
    4565 
    4566              ENDIF
    4567 
    45684452          ENDIF
    45694453!
     
    46624546                ENDDO
    46634547             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             
    47034549          ENDIF
    47044550
     
    47624608          ENDDO
    47634609       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   
    48054611   END SUBROUTINE pmci_interpolation
    48064612
     
    54135219      ENDIF
    54145220
    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
    56235222
    56245223
Note: See TracChangeset for help on using the changeset viewer.