Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 3798 for palm/trunk/SOURCE


Ignore:
Timestamp:
Mar 15, 2019 3:06:49 PM (6 years ago)
Author:
hellstea
Message:

A bug fixed in lateral boundary interpolations

File:
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3794 r3798  
    2525! -----------------
    2626! $Id$
     27! A bug fixed in lateral boundary interpolations. Dimension of val changed from 
     28! 5 to 3 in pmci_setup_parent and pmci_setup_child.
     29!
     30! 3794 2019-03-15 09:36:33Z raasch
    2731! two remaining unused variables removed
    2832!
    … …  
    788792    CHARACTER(LEN=32) ::  myname
    789793   
    790     INTEGER(iwp) ::  child_id         !<
    791     INTEGER(iwp) ::  ierr             !<
    792     INTEGER(iwp) ::  k                !<
    793     INTEGER(iwp) ::  m                !<
    794     INTEGER(iwp) ::  mid              !<
    795     INTEGER(iwp) ::  mm               !<
    796     INTEGER(iwp) ::  n = 1            !< running index for chemical species
    797     INTEGER(iwp) ::  nest_overlap     !<
    798     INTEGER(iwp) ::  nomatch          !<
    799     INTEGER(iwp) ::  nx_cl            !<
    800     INTEGER(iwp) ::  ny_cl            !<
    801     INTEGER(iwp) ::  nz_cl            !<
    802 
    803     INTEGER(iwp), DIMENSION(5) ::  val    !<
    804 
    805 
     794    INTEGER(iwp) ::  child_id           !<
     795    INTEGER(iwp) ::  ierr               !<
     796    INTEGER(iwp) ::  k                  !<
     797    INTEGER(iwp) ::  m                  !<
     798    INTEGER(iwp) ::  mid                !<
     799    INTEGER(iwp) ::  mm                 !<
     800    INTEGER(iwp) ::  n = 1              !< Running index for chemical species
     801    INTEGER(iwp) ::  nest_overlap       !<
     802    INTEGER(iwp) ::  nomatch            !<
     803    INTEGER(iwp) ::  nx_cl              !<
     804    INTEGER(iwp) ::  ny_cl              !<
     805    INTEGER(iwp) ::  nz_cl              !<
     806    INTEGER(iwp), DIMENSION(3) ::  val  !< Array for receiving the child-grid dimensions
    806807    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xl   !<
    807808    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xr   !<   
    … …  
    818819    REAL(wp) ::  xez              !<
    819820    REAL(wp) ::  yez              !<
    820     REAL(wp), DIMENSION(5) ::  fval                      !<
     821    REAL(wp), DIMENSION(5) ::  fval                      !< Array for receiving the child-grid spacings etc
    821822    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !<
    822823    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !<
    … …  
    11901191    INTEGER(iwp) ::  jcsw       !< South index limit for children's parent-grid work arrays
    11911192    INTEGER(iwp) ::  n          !< Running index for number of chemical species
    1192     INTEGER(iwp), DIMENSION(5) ::  val        !<
     1193    INTEGER(iwp), DIMENSION(3) ::  val  !< Array for sending the child-grid dimensions to parent
    11931194    REAL(wp) ::  xcs        !<
    11941195    REAL(wp) ::  xce        !<
    … …  
    11961197    REAL(wp) ::  yce        !<
    11971198
    1198     REAL(wp), DIMENSION(5) ::  fval       !<
     1199    REAL(wp), DIMENSION(5) ::  fval     !< Array for sending the child-grid spacings etc to parent
    11991200                                             
    12001201!
    … …  
    12761277       val(2)  = ny
    12771278       val(3)  = nz
    1278        val(4)  = dx
    1279        val(5)  = dy
    12801279       fval(1) = zw(nzt+1)
    12811280       fval(2) = zw(nzt)
    … …  
    35363535!--            Use averages of the neighbouring matching grid-line values
    35373536               DO  j = jfl(m), jfl(m+1)
    3538 !                  f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( workarrc_lr(n,m,lw)       &
    3539 !                       +  workarrc_lr(n,m+1,lw) )
    35403537                  f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( f_interp_1 + f_interp_2 )
    35413538               ENDDO
    … …  
    35433540!--            Then set the values along the matching grid-lines 
    35443541               IF  ( MOD( jfl(m), jgsr ) == 0 )  THEN
    3545 !                  f(kfl(n):kfu(n),jfl(m),ibc) = workarrc_lr(n,m,lw)
    35463542                  f(kfl(n):kfu(n),jfl(m),ibc) = f_interp_1
    35473543               ENDIF
    … …  
    35513547!--      Finally, set the values along the last matching grid-line 
    35523548         IF  ( MOD( jfl(jcnw), jgsr ) == 0 )  THEN
    3553             f_interp_1 = cb * workarrc_lr(n,jcnw,lw) + cp * workarrc_lr(n,jcnw,lwp)
    35543549            DO  n = 0, kct
    3555 !               f(kfl(n):kfu(n),jfl(jcnw),ibc) = workarrc_lr(n,jcnw,lw)
     3550               f_interp_1 = cb * workarrc_lr(n,jcnw,lw) + cp * workarrc_lr(n,jcnw,lwp)
    35563551               f(kfl(n):kfu(n),jfl(jcnw),ibc) = f_interp_1
    35573552            ENDDO
    … …  
    35793574!
    35803575!--            First substitute only the matching-node values
    3581 !               f(kfu(n),jfl(m):jfu(m),ibc) = workarrc_lr(n,m,lw)
    35823576               f(kfu(n),jfl(m):jfu(m),ibc) = f_interp_1
    35833577                 
    … …  
    36063600               DO  j = jfl(m), jfu(m)
    36073601                  DO  k = kfl(n), kfu(n)
    3608 !                     f(k,j,ibc) = workarrc_lr(n,m,lw)
    36093602                     f(k,j,ibc) = f_interp_1
    36103603                  ENDDO
    … …  
    37713764!--            Use averages of the neighbouring matching grid-line values
    37723765               DO  i = ifl(l), ifl(l+1)
    3773 !                  f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( workarrc_sn(n,mw,l)       &
    3774 !                       +  workarrc_sn(n,mw,l+1) )
    37753766                  f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( f_interp_1 + f_interp_2 )
    37763767               ENDDO
    … …  
    37783769!--            Then set the values along the matching grid-lines 
    37793770               IF  ( MOD( ifl(l), igsr ) == 0 )  THEN
    3780 !                  f(kfl(n):kfu(n),jbc,ifl(l)) = workarrc_sn(n,mw,l)
    37813771                  f(kfl(n):kfu(n),jbc,ifl(l)) = f_interp_1
    37823772               ENDIF
    … …  
    37873777!--      Finally, set the values along the last matching grid-line 
    37883778         IF  ( MOD( ifl(icrw), igsr ) == 0 )  THEN
    3789             f_interp_1 = cb * workarrc_sn(n,mw,icrw) + cp * workarrc_sn(n,mwp,icrw)
    37903779            DO  n = 0, kct
    3791 !               f(kfl(n):kfu(n),jbc,ifl(icrw)) = workarrc_sn(n,mw,icrw)
     3780               f_interp_1 = cb * workarrc_sn(n,mw,icrw) + cp * workarrc_sn(n,mwp,icrw)
    37923781               f(kfl(n):kfu(n),jbc,ifl(icrw)) = f_interp_1
    37933782            ENDDO
    … …  
    38153804!                 
    38163805!--            First substitute only the matching-node values                 
    3817 !               f(kfu(n),jbc,ifl(l):ifu(l)) = workarrc_sn(n,mw,l)
    38183806               f(kfu(n),jbc,ifl(l):ifu(l)) = f_interp_1
    38193807
    … …  
    38423830               DO  i = ifl(l), ifu(l)
    38433831                  DO  k = kfl(n), kfu(n)
    3844 !                     f(k,jbc,i) = workarrc_sn(n,mw,l)
    38453832                     f(k,jbc,i) = f_interp_1
    38463833                  ENDDO
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |