Changeset 3946 for palm/trunk

Timestamp:

May 2, 2019 2:18:59 PM (6 years ago)

Author:

hellstea

Message:

New checks added for nested setups

File:

• palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (7 diffs)

palm/trunk/SOURCE/pmc_interface_mod.f90

@@ -21 +21 @@
 ! ------------------
 ! 
-!
+! 
 ! Former revisions:
 ! -----------------
 ! $Id$
+! Check added for child domains too small in terms of number of parent-grid cells so
+! that anterpolation is not possible. Checks added for too wide anterpolation buffer
+! for the same reason. Some minor code reformatting done.
+!
+! 3945 2019-05-02 11:29:27Z raasch
 !
 ! 3932 2019-04-24 17:31:34Z suehring
@@ -1127 +1132 @@
        CALL pmci_create_index_list
 !
-!--    Include couple arrays into parent content
-!--    The adresses of the PALM 2D or 3D array (here server coarse grid) which are candidates
+!--    Include couple arrays into parent content.
+!--    The adresses of the PALM 2D or 3D array (here parent grid) which are candidates
 !--    for coupling are stored once into the pmc context. While data transfer, the array do not
 !--    have to be specified again
@@ -1134 +1139 @@
        DO WHILE ( pmc_s_getnextarray( child_id, myname ) )
           IF ( INDEX( TRIM( myname ), 'chem_' ) /= 0 )  THEN             
-             CALL pmci_set_array_pointer( myname, child_id = child_id,         &
-                                          nz_child = nz_child, n = n )
+             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = n )
              n = n + 1  
           ELSEIF ( INDEX( TRIM( myname ), 'an_' ) /= 0 )  THEN
-             CALL pmci_set_array_pointer( myname, child_id = child_id,         &
-                                          nz_child = nz_child, n = lb )
+             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lb )
              lb = lb + 1 
           ELSEIF ( INDEX( TRIM( myname ), 'am_' ) /= 0 )  THEN
-             CALL pmci_set_array_pointer( myname, child_id = child_id,         &
-                                          nz_child = nz_child, n = lc )
+             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lc )
              lc = lc + 1 
-          ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.                  &
-             .NOT. salsa_gases_from_chem )                                     &
-          THEN
-             CALL pmci_set_array_pointer( myname, child_id = child_id,         &
-                                          nz_child = nz_child, n = lg )
+          ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.  .NOT. salsa_gases_from_chem )  THEN
+             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child, n = lg )
              lg = lg + 1
           ELSE
@@ -1175 +1174 @@
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  ilist              !< Index-list index running over the child's parent-grid jc,ic-space
-       INTEGER(iwp) ::  index_list_size    !< Dimension 2 of the array index_list
-       INTEGER(iwp) ::  ierr               !< MPI error code
-       INTEGER(iwp) ::  ip                 !< Running parent-grid index on the child domain in the x-direction 
-       INTEGER(iwp) ::  jp                 !< Running parent-grid index on the child domain in the y-direction
-       INTEGER(iwp) ::  n                  !< Running index over child subdomains
-       INTEGER(iwp) ::  nrx                !< Parent subdomain dimension in the x-direction
-       INTEGER(iwp) ::  nry                !< Parent subdomain dimension in the y-direction
-       INTEGER(iwp) ::  pex                !< Two-dimensional subdomain (pe) index in the x-direction
-       INTEGER(iwp) ::  pey                !< Two-dimensional subdomain (pe) index in the y-direction
-       INTEGER(iwp) ::  parent_pe          !< Parent subdomain index (one-dimensional)
+       INTEGER(iwp) ::  ilist            !< Index-list index running over the child's parent-grid jc,ic-space
+       INTEGER(iwp) ::  index_list_size  !< Dimension 2 of the array index_list
+       INTEGER(iwp) ::  ierr             !< MPI error code
+       INTEGER(iwp) ::  ip               !< Running parent-grid index on the child domain in the x-direction 
+       INTEGER(iwp) ::  jp               !< Running parent-grid index on the child domain in the y-direction
+       INTEGER(iwp) ::  n                !< Running index over child subdomains
+       INTEGER(iwp) ::  nrx              !< Parent subdomain dimension in the x-direction
+       INTEGER(iwp) ::  nry              !< Parent subdomain dimension in the y-direction
+       INTEGER(iwp) ::  pex              !< Two-dimensional subdomain (pe) index in the x-direction
+       INTEGER(iwp) ::  pey              !< Two-dimensional subdomain (pe) index in the y-direction
+       INTEGER(iwp) ::  parent_pe        !< Parent subdomain index (one-dimensional)
 
        INTEGER(iwp), DIMENSION(2) ::  pe_indices_2d                                  !< Array for two-dimensional subdomain (pe)
@@ -1236 +1235 @@
                    ilist = ilist + 1
 !
-!--                First index in parent array   ! TO_DO: IMPROVE THIS COMMENT
+!--                First index in parent array  ! TO_DO: Klaus, please explain better
                    index_list(1,ilist) = ip - ( pex * nrx ) + 1 + nbgp
 !
-!--                Second index in parent array   ! TO_DO: IMPROVE THIS COMMENT
+!--                Second index in parent array  ! TO_DO: Klaus, please explain better
                    index_list(2,ilist) = jp - ( pey * nry ) + 1 + nbgp
 !
-!--                x index of child's parent grid
+!--                x index of child's parent grid 
                    index_list(3,ilist) = ip - childs_parent_grid_bounds_all(1,n) + 1
 !
@@ -1354 +1353 @@
 !
 !--    Nesting of dissipation rate only if both parent and child are in RANS
-!--    mode and TKE-epsilo closure is applied. Please see also comment for TKE
+!--    mode and TKE-epsilon closure is applied. Please see also comment for TKE
 !--    above.
        IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
@@ -1730 +1729 @@
             iplg, iprg, jpsg, jpng
        FLUSH( 9 )
+!       
+!--    Check if the child domain is too small in terms of number of parent-grid cells 
+!--    covered so that anterpolation buffers fill the whole domain so that anterpolation
+!--    not possible. Also, check that anterpolation_buffer_width is not too large to  
+!--    prevent anterpolation.
+       IF ( nesting_mode == 'two-way')  THEN
+!
+!--       First x-direction
+          IF ( iplg + 3 + anterpolation_buffer_width > iprg - 3 - anterpolation_buffer_width )  THEN
+             IF ( iprg - iplg + 1 < 7 )  THEN
+!
+!--             Error
+                WRITE( message_string, * ) 'child domain too narrow for anterpolation in x-direction'
+                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 )
+             ELSE IF ( iprg - iplg + 1 < 11 )  THEN
+!                
+!--             Warning
+                WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
+                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 )
+                anterpolation_buffer_width = 0
+             ELSE
+!                
+!--             Informative message
+                WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2'
+                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 )
+                anterpolation_buffer_width = 2
+             ENDIF
+          ENDIF
+!
+!--       Then y-direction          
+          IF ( jpsg + 3 + anterpolation_buffer_width > jpng - 3 - anterpolation_buffer_width )  THEN
+             IF ( jpng - jpsg + 1 < 7 )  THEN
+!
+!--             Error
+                WRITE( message_string, * ) 'child domain too narrow for anterpolation in y-direction'
+                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 )
+             ELSE IF ( jpng - jpsg + 1 < 11 )  THEN
+!                
+!--             Warning
+                WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to 0'
+                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0653', 0, 1, 0, 6, 0 )
+                anterpolation_buffer_width = 0
+             ELSE
+!                
+!--             Informative message
+                WRITE( message_string, * ) 'anterpolation_buffer_width value too high, reset to default value 2'
+                CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0654', 0, 0, 0, 6, 0 )
+                anterpolation_buffer_width = 2
+             ENDIF
+          ENDIF
+
+       ENDIF
        
     END SUBROUTINE pmci_map_fine_to_coarse_grid