Home


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

Changeset 3697 for palm/trunk


Ignore:
Timestamp:
Jan 24, 2019 5:16:13 PM (6 years ago)
Author:
hellstea
Message:

bugfix in child initialization in pmc_interface_mod

Location:
palm/trunk
Files:
26 deleted
1 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3681 r3697  
    2525! -----------------
    2626! $Id$
     27! Bugfix: upper k-bound in the child initialization interpolation
     28! pmci_interp_1sto_all corrected.
     29! Copying of the nest boundary values into the redundant 2nd and 3rd ghost-node
     30! layers is added to the pmci_interp_1sto_*-routines.
     31!
     32! 3681 2019-01-18 15:06:05Z hellstea
    2733! Linear interpolations are replaced by first order interpolations. The linear
    2834! interpolation routines are still included but not called. In the child
    … …  
    39703976    IF ( air_chemistry  .AND.  nest_chemistry )                                &
    39713977       pmc_max_array = pmc_max_array + nspec
    3972 
    3973 
    39743978#endif
    39753979 END SUBROUTINE pmci_num_arrays
    … …  
    45344538          DO  l = lb, le
    45354539             DO  m = mb, me
    4536                 DO n = 0, kct
     4540                DO n = 0, kct + 1
    45374541
    45384542                   DO  i = ifl(l), ifl(l+1)-1
    45394543                      DO  j = jfl(m), jfu(m)
    4540                          DO  k = kfl(n), kfu(n)
     4544                         DO  k = kfl(n), MIN( kfu(n), nzt+1 )
    45414545                            f(k,j,i) = fc(n,m,l)
    45424546                         ENDDO
    … …  
    45524556          DO  l = lb, le
    45534557             DO  m = mb, me
    4554                 DO n = 0, kct
     4558                DO n = 0, kct + 1 
    45554559               
    45564560                   DO i = ifl(l), ifu(l)
    45574561                      DO  j = jfl(m), jfl(m+1)-1
    4558                          DO  k = kfl(n), kfu(n)
     4562                         DO  k = kfl(n), MIN( kfu(n), nzt+1 )
    45594563                            f(k,j,i) = fc(n,m,l)
    45604564                         ENDDO
    … …  
    45704574          DO  l = lb, le
    45714575             DO  m = mb, me
    4572                 DO n = 1, kct + 1   ! It is important to go up to kct+1 
     4576                DO n = 1, kct + 1 
    45734577
    45744578                   DO i = ifl(l), ifu(l)
    … …  
    45894593          DO  l = lb, le
    45904594             DO  m = mb, me
    4591                 DO n = 0, kct
     4595                DO n = 0, kct + 1
    45924596                   
    45934597                   DO i = ifl(l), ifu(l)
    45944598                      DO  j = jfl(m), jfu(m)
    4595                          DO  k = kfl(n), kfu(n)
     4599                         DO  k = kfl(n), MIN( kfu(n), nzt+1 )
    45964600                            f(k,j,i) = fc(n,m,l)
    45974601                         ENDDO
    … …  
    57385742      INTEGER(iwp) ::  iaw      !< Reduced ia-index for workarr_lr
    57395743      INTEGER(iwp) ::  iawbc    !< iaw-index pointing to the boundary-value nodes (either 0 or igsr-1)     
     5744      INTEGER(iwp) ::  ib       !< Fixed i-index pointing to the node just behind the boundary-value node
    57405745      INTEGER(iwp) ::  ibc      !< Fixed i-index pointing to the boundary-value nodes (either i or iend)
     5746      INTEGER(iwp) ::  ibgp     !< Index running over the redundant boundary ghost points in i-direction
    57415747!AH      INTEGER(iwp) ::  ibeg     !< i-index pointing to the starting point of workarr_lr in the i-direction
    57425748      INTEGER(iwp) ::  iend     !< Upper bound of the running index ia
    … …  
    57885794            i     = nxl
    57895795            iend  = nxl
    5790             ibc   = nxl
     5796            ibc   = nxl   
     5797            ib    = ibc - 1
    57915798            iawbc = 0
    57925799            l     = icl + 2
    57935800            lw    = 2
    57945801            lbeg  = icl
    5795             loff  = 0
     5802            loff  = 0           
    57965803         ELSE
    57975804            i     = nxl - igsr
    57985805            iend  = nxl - 1
    57995806            ibc   = nxl - 1
     5807            ib    = ibc - 1
    58005808            iawbc = igsr-1
    58015809            l     = icl + 1
    … …  
    58035811            lbeg  = icl
    58045812            loff  = 0
    5805          ENDIF
     5813         ENDIF       
    58065814      ELSEIF ( edge == 'r' )  THEN
    58075815         IF ( var == 'u' )  THEN
    … …  
    58095817            iend  = nxr + 1
    58105818            ibc   = nxr + 1
     5819            ib    = ibc + 1
    58115820            iawbc = 0
    58125821            l     = icr - 1
    … …  
    58185827            iend  = nxr + igsr
    58195828            ibc   = nxr + 1
     5829            ib    = ibc + 1
    58205830            iawbc = 0
    58215831            l     = icr - 1
    … …  
    58235833            lbeg  = icr - 2
    58245834            loff  = 1
    5825          ENDIF
     5835         ENDIF         
    58265836      ENDIF
    58275837
    … …  
    59445954
    59455955      ENDIF  ! var
     5956!
     5957!--   Fill up also the redundant 2nd and 3rd ghost-node layers
     5958      IF ( edge == 'l' )  THEN
     5959         DO  ibgp = -nbgp, ib
     5960            f(0:nzt+1,nysg:nyng,ibgp) = f(0:nzt+1,nysg:nyng,ibc)
     5961         ENDDO
     5962      ELSEIF ( edge == 'r' )  THEN
     5963         DO  ibgp = ib, nx+nbgp
     5964            f(0:nzt+1,nysg:nyng,ibgp) = f(0:nzt+1,nysg:nyng,ibc)
     5965         ENDDO
     5966      ENDIF
    59465967
    59475968   END SUBROUTINE pmci_interp_1sto_lr
    … …  
    60266047      INTEGER(iwp) ::  jawbc    !< jaw-index pointing to the boundary-value nodes (either 0 or jgsr-1)
    60276048!AH      INTEGER(iwp) ::  jbeg     !< j-index pointing to the starting point of workarr_sn in the j-direction
     6049      INTEGER(iwp) ::  jb       !< Fixed j-index pointing to the node just behind the boundary-value node
    60286050      INTEGER(iwp) ::  jbc      !< Fixed j-index pointing to the boundary-value nodes (either j or jend)
     6051      INTEGER(iwp) ::  jbgp     !< Index running over the redundant boundary ghost points in j-direction
    60296052      INTEGER(iwp) ::  jend     !< Upper bound of the running index ja
    60306053      INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
    … …  
    60696092            jawbc = 0
    60706093            jbc   = nys
     6094            jb    = jbc - 1
    60716095            m     = jcs + 2
    60726096            mw    = 2
    … …  
    60786102            jawbc = jgsr - 1
    60796103            jbc   = nys - 1
     6104            jb    = jbc - 1
    60806105            m     = jcs + 1
    60816106            mw    = 1
    … …  
    60896114            jawbc = 0
    60906115            jbc   = nyn + 1
     6116            jb    = jbc + 1
    60916117            m     = jcn - 1
    60926118            mw    = 1
    … …  
    60986124            jawbc = 0
    60996125            jbc   = nyn + 1
     6126            jb    = jbc + 1
    61006127            m     = jcn - 1
    61016128            mw    = 1
    … …  
    61876214                  DO  k = kfl(n), kfu(n)
    61886215                     f(k,jbc,i) = fc(n,m,l)
     6216!AH
     6217!                     write(9,"('sn u: ',6(i3,2x),2(e12.5,2x))") n, m, l, k, jbc, i, fc(n,m,l), f(k,jbc,i)
     6218!                     flush(9)
     6219!AH
    61896220                  ENDDO
    61906221               ENDDO
    … …  
    62236254
    62246255      ENDIF  ! var
     6256!
     6257!--   Fill up also the redundant 2nd and 3rd ghost-node layers
     6258      IF ( edge == 's' )  THEN
     6259         DO  jbgp = -nbgp, jb
     6260            f(0:nzt+1,jbgp,nxlg:nxrg) = f(0:nzt+1,jbc,nxlg:nxrg)
     6261         ENDDO
     6262      ELSEIF ( edge == 'n' )  THEN
     6263         DO  jbgp = jb, ny+nbgp
     6264            f(0:nzt+1,jbgp,nxlg:nxrg) = f(0:nzt+1,jbc,nxlg:nxrg)
     6265         ENDDO
     6266      ENDIF
    62256267
    62266268   END SUBROUTINE pmci_interp_1sto_sn
    … …  
    64646506
    64656507      ENDIF  ! var
     6508!
     6509!--   Just fill up the redundant second ghost-node layer in case of var == w.
     6510      IF ( var == 'w' )  THEN
     6511         f(nzt+1,:,:) = f(nzt,:,:)
     6512      ENDIF
    64666513
    64676514   END SUBROUTINE pmci_interp_1sto_t
    … …  
    79367983          ENDIF
    79377984          IF ( bc_dirichlet_r )  THEN
    7938 !             icrant = icr - 5
    79397985             icrant = icr - 3
    79407986          ENDIF
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |