Changeset 3947 for palm/trunk

Timestamp:

May 3, 2019 7:56:44 AM (6 years ago)

Author:

hellstea

Message:

Child-domain size checks extended

File:

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

palm/trunk/SOURCE/pmc_interface_mod.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! The checks included in 3946 are extended for the z-direction and moved into its
+! own subroutine called from pmci_define_index_mapping.
+! 
+! 3946 2019-05-02 14:18:59Z hellstea
 ! 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
@@ -1729 +1733 @@
             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
@@ -1839 +1791 @@
        WRITE( 9, "('kcto, kctw = ', 2(i3,2x))" ) kcto, kctw
        FLUSH( 9 )
+!       
+!--    In case of two-way coupling, check that the child domain is sufficiently 
+!--    large in terms of the number of parent-grid cells covered. Otherwise
+!--    anterpolation is not possible.
+       IF ( nesting_mode == 'two-way')  THEN
+          CALL pmci_check_child_domain_size
+       ENDIF
        
        ALLOCATE( iflu(ipla:ipra) )
@@ -2089 +2048 @@
 
     END SUBROUTINE pmci_define_index_mapping
+
+
+
+    SUBROUTINE pmci_check_child_domain_size
+!       
+!--    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.
+       IMPLICIT NONE
+      
+!
+!--    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
+!
+!--    Finally z-direction               
+       IF ( kctw - 1 - anterpolation_buffer_width < 1 )  THEN
+          IF ( kctw - 1 < 1 )  THEN
+!
+!--          Error
+             WRITE( message_string, * ) 'child domain too shallow for anterpolation in z-direction'
+             CALL message( 'pmci_map_fine_to_coarse_grid', 'PA0652', 3, 2, 0, 6, 0 )
+          ELSE IF ( kctw - 3 < 1 )  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
+
+    END SUBROUTINE pmci_check_child_domain_size
+
+
     
-
-
     SUBROUTINE pmci_allocate_workarrays
 !