Changeset 4385 for palm/trunk/SOURCE/pmc_interface_mod.f90

Timestamp:

Jan 27, 2020 8:37:37 AM (5 years ago)

Author:

hellstea

Message:

Nesting-related error messages PA0425 and PA0426 made more specific

File:

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

palm/trunk/SOURCE/pmc_interface_mod.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Error messages PA0425 and PA0426 made more specific
+! 
+! 4360 2020-01-07 11:25:50Z suehring
 ! Introduction of wall_flags_total_0, which currently sets bits based on static
 ! topography information used in wall_flags_static_0
@@ -666 +669 @@
     INTEGER(iwp) ::  msib               !< Loop index over all other children than m in case of siblings (parallel children)
     INTEGER(iwp) ::  n = 1              !< Running index for chemical species
-    INTEGER(iwp) ::  nest_overlap = 0   !< Tag for parallel child-domains' overlap situation (>0 if overlap found)
-    INTEGER(iwp) ::  nomatch = 0        !< Tag for child-domain mismatch situation (>0 if mismatch found)
     INTEGER(iwp) ::  nx_child           !< Number of child-grid points in the x-direction
     INTEGER(iwp) ::  ny_child           !< Number of child-grid points in the y-direction
     INTEGER(iwp) ::  nz_child           !< Number of child-grid points in the z-direction
+    INTEGER(iwp) ::  sibling_id         !< Child id-number for the child msib (sibling of child m)
     
     INTEGER(iwp), DIMENSION(3) ::  child_grid_dim  !< Array for receiving the child-grid dimensions from the children
@@ -724 +726 @@
                                       !< of the child msib is within the y-range of the child m
 
-
 !
 !-- Grid-line tolerances.
@@ -801 +802 @@
              right_limit = upper_right_coord_x
              north_limit = upper_right_coord_y
-             IF ( ( ABS( child_coord_x(nx_child+1) - right_limit ) > tolex )  .OR.                  &
-                  ( ABS( child_coord_y(ny_child+1) - north_limit ) > toley ) )  THEN                
-                nomatch = 1
+             IF ( ABS( child_coord_x(nx_child+1) - right_limit ) > tolex )  THEN
+                WRITE ( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
+                     ') domain right edge does not match its parent right edge'
+                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
+             ENDIF
+             IF ( ABS( child_coord_y(ny_child+1) - north_limit ) > toley )  THEN
+                WRITE ( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
+                     ') domain north edge does not match its parent north edge'
+                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
              ENDIF
           ELSE       
@@ -815 +822 @@
              south_limit = lower_left_coord_y + yez
              north_limit = upper_right_coord_y - yez
-             IF ( ( left_limit - child_coord_x(0) > tolex )  .OR.                                   &
-                  ( child_coord_x(nx_child+1) - right_limit > tolex )  .OR.                         &
-                  ( south_limit - child_coord_y(0) > toley )  .OR.                                  &
-                  ( child_coord_y(ny_child+1) - north_limit > toley ) )  THEN
-                nomatch = 1
+             IF ( left_limit - child_coord_x(0) > tolex )  THEN
+                WRITE ( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
+                     ') domain does not fit in its parent domain, left edge is either too ' //      &
+                     'close or outside its parent left edge' 
+                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
+             ENDIF
+             IF ( child_coord_x(nx_child+1) - right_limit > tolex )  THEN
+                WRITE ( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
+                     ') domain does not fit in its parent domain, right edge is either too ' //     &
+                     'close or outside its parent right edge' 
+                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
+             ENDIF
+             IF ( south_limit - child_coord_y(0) > toley )  THEN
+                WRITE ( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
+                     ') domain does not fit in its parent domain, south edge is either too ' //     &
+                     'close or outside its parent south edge' 
+                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
+             ENDIF
+             IF ( child_coord_y(ny_child+1) - north_limit > toley )  THEN
+                WRITE ( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                 &
+                     ') domain does not fit in its parent domain, north edge is either too ' //     &
+                     'close or outside its parent north edge' 
+                CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
              ENDIF
           ENDIF
@@ -826 +851 @@
 !--       layer of the child grid does not exceed the parent domain top boundary.
           IF ( child_height - zw(nzt) > tolez ) THEN
-             nomatch = 1
+             WRITE ( message_string, "(a,i2,a)" ) 'nested child (id: ',child_id,                    &
+                     ') domain does not fit in its parent domain, top edge is either too ' //       &
+                     'close or above its parent top edge' 
+             CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
           ENDIF
 !
@@ -866 +894 @@
                      ( m_south_in_msib  .OR.  m_north_in_msib  .OR.                                 &
                        msib_south_in_m  .OR.  msib_north_in_m ) )  THEN
-                     nest_overlap = 1
+                   sibling_id = pmc_parent_for_child(msib)
+                   WRITE ( message_string, "(a,i2,a,i2,a)" ) 'nested parallel child domains (ids: ',&
+                        child_id, ' and ', sibling_id, ') overlap'
+                   CALL message( 'pmci_setup_parent', 'PA0426', 3, 2, 0, 6, 0 )
                 ENDIF
 
@@ -899 +930 @@
           CALL pmc_send_to_child( child_id, zu,  nz_child + 2, 0, 28, ierr )
           CALL pmc_send_to_child( child_id, zw,  nz_child + 2, 0, 29, ierr )
-
-          IF ( nomatch /= 0 )  THEN
-             WRITE ( message_string, * ) 'nested child domain does not fit into its parent domain'
-             CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
-          ENDIF
-  
-          IF ( nest_overlap /= 0  .AND.  nesting_mode /= 'vertical' )  THEN
-             WRITE ( message_string, * ) 'nested parallel child domains overlap'
-             CALL message( 'pmci_setup_parent', 'PA0426', 3, 2, 0, 6, 0 )
-          ENDIF
           
        ENDIF  ! ( myid == 0 )