Changeset 3946


Ignore:
Timestamp:
May 2, 2019 2:18:59 PM (2 years ago)
Author:
hellstea
Message:

New checks added for nested setups

File:
1 edited

Legend:

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

    r3945 r3946  
    2121! ------------------
    2222!
    23 !
     23! 
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27! Check added for child domains too small in terms of number of parent-grid cells so
     28! that anterpolation is not possible. Checks added for too wide anterpolation buffer
     29! for the same reason. Some minor code reformatting done.
     30!
     31! 3945 2019-05-02 11:29:27Z raasch
    2732!
    2833! 3932 2019-04-24 17:31:34Z suehring
     
    11271132       CALL pmci_create_index_list
    11281133!
    1129 !--    Include couple arrays into parent content
    1130 !--    The adresses of the PALM 2D or 3D array (here server coarse grid) which are candidates
     1134!--    Include couple arrays into parent content.
     1135!--    The adresses of the PALM 2D or 3D array (here parent grid) which are candidates
    11311136!--    for coupling are stored once into the pmc context. While data transfer, the array do not
    11321137!--    have to be specified again
     
    11341139       DO WHILE ( pmc_s_getnextarray( child_id, myname ) )
    11351140          IF ( INDEX( TRIM( myname ), 'chem_' ) /= 0 )  THEN             
    1136              CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1137                                           nz_child = nz_child, n = n )
     1141             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = n )
    11381142             n = n + 1 
    11391143          ELSEIF ( INDEX( TRIM( myname ), 'an_' ) /= 0 )  THEN
    1140              CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1141                                           nz_child = nz_child, n = lb )
     1144             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lb )
    11421145             lb = lb + 1
    11431146          ELSEIF ( INDEX( TRIM( myname ), 'am_' ) /= 0 )  THEN
    1144              CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1145                                           nz_child = nz_child, n = lc )
     1147             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lc )
    11461148             lc = lc + 1
    1147           ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.                  &
    1148              .NOT. salsa_gases_from_chem )                                     &
    1149           THEN
    1150              CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1151                                           nz_child = nz_child, n = lg )
     1149          ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.  .NOT. salsa_gases_from_chem )  THEN
     1150             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lg )
    11521151             lg = lg + 1
    11531152          ELSE
     
    11751174       IMPLICIT NONE
    11761175
    1177        INTEGER(iwp) ::  ilist              !< Index-list index running over the child's parent-grid jc,ic-space
    1178        INTEGER(iwp) ::  index_list_size    !< Dimension 2 of the array index_list
    1179        INTEGER(iwp) ::  ierr               !< MPI error code
    1180        INTEGER(iwp) ::  ip                 !< Running parent-grid index on the child domain in the x-direction
    1181        INTEGER(iwp) ::  jp                 !< Running parent-grid index on the child domain in the y-direction
    1182        INTEGER(iwp) ::  n                  !< Running index over child subdomains
    1183        INTEGER(iwp) ::  nrx                !< Parent subdomain dimension in the x-direction
    1184        INTEGER(iwp) ::  nry                !< Parent subdomain dimension in the y-direction
    1185        INTEGER(iwp) ::  pex                !< Two-dimensional subdomain (pe) index in the x-direction
    1186        INTEGER(iwp) ::  pey                !< Two-dimensional subdomain (pe) index in the y-direction
    1187        INTEGER(iwp) ::  parent_pe          !< Parent subdomain index (one-dimensional)
     1176       INTEGER(iwp) ::  ilist            !< Index-list index running over the child's parent-grid jc,ic-space
     1177       INTEGER(iwp) ::  index_list_size  !< Dimension 2 of the array index_list
     1178       INTEGER(iwp) ::  ierr             !< MPI error code
     1179       INTEGER(iwp) ::  ip               !< Running parent-grid index on the child domain in the x-direction
     1180       INTEGER(iwp) ::  jp               !< Running parent-grid index on the child domain in the y-direction
     1181       INTEGER(iwp) ::  n                !< Running index over child subdomains
     1182       INTEGER(iwp) ::  nrx              !< Parent subdomain dimension in the x-direction
     1183       INTEGER(iwp) ::  nry              !< Parent subdomain dimension in the y-direction
     1184       INTEGER(iwp) ::  pex              !< Two-dimensional subdomain (pe) index in the x-direction
     1185       INTEGER(iwp) ::  pey              !< Two-dimensional subdomain (pe) index in the y-direction
     1186       INTEGER(iwp) ::  parent_pe        !< Parent subdomain index (one-dimensional)
    11881187
    11891188       INTEGER(iwp), DIMENSION(2) ::  pe_indices_2d                                  !< Array for two-dimensional subdomain (pe)
     
    12361235                   ilist = ilist + 1
    12371236!
    1238 !--                First index in parent array   ! TO_DO: IMPROVE THIS COMMENT
     1237!--                First index in parent array  ! TO_DO: Klaus, please explain better
    12391238                   index_list(1,ilist) = ip - ( pex * nrx ) + 1 + nbgp
    12401239!
    1241 !--                Second index in parent array   ! TO_DO: IMPROVE THIS COMMENT
     1240!--                Second index in parent array  ! TO_DO: Klaus, please explain better
    12421241                   index_list(2,ilist) = jp - ( pey * nry ) + 1 + nbgp
    12431242!
    1244 !--                x index of child's parent grid
     1243!--                x index of child's parent grid 
    12451244                   index_list(3,ilist) = ip - childs_parent_grid_bounds_all(1,n) + 1
    12461245!
     
    13541353!
    13551354!--    Nesting of dissipation rate only if both parent and child are in RANS
    1356 !--    mode and TKE-epsilo closure is applied. Please see also comment for TKE
     1355!--    mode and TKE-epsilon closure is applied. Please see also comment for TKE
    13571356!--    above.
    13581357       IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
     
    17301729            iplg, iprg, jpsg, jpng
    17311730       FLUSH( 9 )
     1731!       
     1732!--    Check if the child domain is too small in terms of number of parent-grid cells
     1733!--    covered so that anterpolation buffers fill the whole domain so that anterpolation
     1734!--    not possible. Also, check that anterpolation_buffer_width is not too large to 
     1735!--    prevent anterpolation.
     1736       IF ( nesting_mode == 'two-way')  THEN
     1737!
     1738!--       First x-direction
     1739          IF ( iplg + 3 + anterpolation_buffer_width > iprg - 3 - anterpolation_buffer_width )  THEN
     1740             IF ( iprg - iplg + 1 < 7 )  THEN
     1741!
     1742!--             Error
     1743                WRITE( message_string, * ) 'child domain too narrow for anterpolation in x-direction'
     1744                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 )
     1745             ELSE IF ( iprg - iplg + 1 < 11 )  THEN
     1746!               
     1747!--             Warning
     1748                WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
     1749                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 )
     1750                anterpolation_buffer_width = 0
     1751             ELSE
     1752!               
     1753!--             Informative message
     1754                WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2'
     1755                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 )
     1756                anterpolation_buffer_width = 2
     1757             ENDIF
     1758          ENDIF
     1759!
     1760!--       Then y-direction         
     1761          IF ( jpsg + 3 + anterpolation_buffer_width > jpng - 3 - anterpolation_buffer_width )  THEN
     1762             IF ( jpng - jpsg + 1 < 7 )  THEN
     1763!
     1764!--             Error
     1765                WRITE( message_string, * ) 'child domain too narrow for anterpolation in y-direction'
     1766                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 )
     1767             ELSE IF ( jpng - jpsg + 1 < 11 )  THEN
     1768!               
     1769!--             Warning
     1770                WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
     1771                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 )
     1772                anterpolation_buffer_width = 0
     1773             ELSE
     1774!               
     1775!--             Informative message
     1776                WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2'
     1777                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 )
     1778                anterpolation_buffer_width = 2
     1779             ENDIF
     1780          ENDIF
     1781
     1782       ENDIF
    17321783       
    17331784    END SUBROUTINE pmci_map_fine_to_coarse_grid
Note: See TracChangeset for help on using the changeset viewer.