Changeset 3822 for palm/trunk


Ignore:
Timestamp:
Mar 27, 2019 1:10:23 PM (5 years ago)
Author:
hellstea
Message:

Temporary increase of the vertical dimension of the parent-grid arrays and workarrc_t is cancelled as unnecessary

File:
1 edited

Legend:

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

    r3819 r3822  
    2525! -----------------
    2626! $Id$
     27! Temporary increase of the vertical dimension of the parent-grid arrays and
     28! workarrc_t is cancelled as unnecessary.
     29!
     30! 3819 2019-03-27 11:01:36Z hellstea
    2731! Adjustable anterpolation buffer introduced on all nest boundaries, it is controlled
    2832! by the new nesting_parameters parameter anterpolation_buffer_width.
     
    879883!--       transfer
    880884          DO  k = 1, nz                 
    881 !AH  Let's try to make the parent-grid arrays higher by one parent dz
    882 !AH             IF ( zw(k) > fval(1) )  THEN
    883              IF ( zw(k) > fval(1)+dz(1) )  THEN
     885             IF ( zw(k) > fval(1) )  THEN
    884886                nz_cl = k
    885887                EXIT
    886888             ENDIF
    887889          ENDDO
    888 
    889 !AH  Let's make the parent-grid arrays higher by one parent dz
    890 !AH          zmax_coarse = fval(1:2)
    891 !AH          cl_height   = fval(1)
    892           zmax_coarse(1) = fval(1) + dz(1)
    893           zmax_coarse(2) = fval(2) + dz(1)
    894           cl_height   = fval(1) + dz(1)
    895 !AH
    896 
     890          zmax_coarse = fval(1:2)
     891          cl_height   = fval(1)
    897892!   
    898893!--       Get absolute coordinates from the child
     
    19031898!
    19041899!--    Top boundary.
    1905 !AH       ALLOCATE( workarrc_t(0:2,jcsw:jcnw,iclw:icrw) )
    1906        ALLOCATE( workarrc_t(-2:3,jcsw:jcnw,iclw:icrw) )
     1900       ALLOCATE( workarrc_t(0:2,jcsw:jcnw,iclw:icrw) )
    19071901
    19081902    END SUBROUTINE pmci_allocate_workarrays
     
    19281922!
    19291923!--    For the top-boundary x-slices
    1930 !AH       CALL MPI_TYPE_VECTOR( icrw-iclw+1, 3, 3*(jcnw-jcsw+1), MPI_REAL,         &
    1931 !AH            workarrc_t_exchange_type_x, ierr )
    1932        CALL MPI_TYPE_VECTOR( icrw-iclw+1, 6, 6*(jcnw-jcsw+1), MPI_REAL,         &
     1924       CALL MPI_TYPE_VECTOR( icrw-iclw+1, 3, 3*(jcnw-jcsw+1), MPI_REAL,         &
    19331925            workarrc_t_exchange_type_x, ierr )
    19341926       CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_x, ierr )
    19351927!
    19361928!--    For the top-boundary y-slices
    1937 !AH       CALL MPI_TYPE_VECTOR( 1, 3*(jcnw-jcsw+1), 3*(jcnw-jcsw+1), MPI_REAL,     &
    1938 !AH            workarrc_t_exchange_type_y, ierr )
    1939        CALL MPI_TYPE_VECTOR( 1, 6*(jcnw-jcsw+1), 6*(jcnw-jcsw+1), MPI_REAL,     &
     1929       CALL MPI_TYPE_VECTOR( 1, 3*(jcnw-jcsw+1), 3*(jcnw-jcsw+1), MPI_REAL,     &
    19401930            workarrc_t_exchange_type_y, ierr )
    19411931       CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_y, ierr )
     
    39683958      ENDIF
    39693959      workarrc_t = 0.0_wp
    3970       workarrc_t(-2:3,jcsc:jcnc,iclc:icrc) = fc(kct-2:kct+3,jcsc:jcnc,iclc:icrc)
     3960!      workarrc_t(-2:3,jcsc:jcnc,iclc:icrc) = fc(kct-2:kct+3,jcsc:jcnc,iclc:icrc)
     3961      workarrc_t(0:2,jcsc:jcnc,iclc:icrc) = fc(kct:kct+2,jcsc:jcnc,iclc:icrc)
    39713962!
    39723963!--   Left-right exchange if more than one PE subdomain in the x-direction.
     
    42084199      kcb  = 0
    42094200      IF ( nesting_mode /= 'vertical' )  THEN
    4210 !         IF ( bc_dirichlet_l )  THEN
    4211 !!            iclant = icl + 3
    4212 !            iclant = icl + 3 + anterpolation_buffer_width
    4213 !         ENDIF
    4214 !         IF ( bc_dirichlet_r )  THEN
    4215 !!            icrant = icr - 3
    4216 !            icrant = icr - 3 - anterpolation_buffer_width
    4217 !         ENDIF
    4218 !
    4219 !         IF ( bc_dirichlet_s )  THEN
    4220 !!            jcsant = jcs + 3
    4221 !            jcsant = jcs + 3 + anterpolation_buffer_width
    4222 !         ENDIF
    4223 !         IF ( bc_dirichlet_n )  THEN
    4224 !!            jcnant = jcn - 3
    4225 !            jcnant = jcn - 3 - anterpolation_buffer_width
    4226 !         ENDIF
    4227 
    4228 !
    4229 !--      New method:
     4201!
     4202!--      Set the anterpolation buffers on the lateral boundaries
    42304203         iclant = MAX( icl, iplg + 3 + anterpolation_buffer_width )
    42314204         icrant = MIN( icr, iprg - 3 - anterpolation_buffer_width )
Note: See TracChangeset for help on using the changeset viewer.