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

Timestamp:

Jun 7, 2016 11:34:42 AM (8 years ago)

Author:

hellstea

Message:

Error check for overlapping parallel nests added

File:

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

palm/trunk/SOURCE/pmc_interface_mod.f90

@@ -539 +539 @@
     INTEGER(iwp) ::  k                !:
     INTEGER(iwp) ::  m                !:
+    INTEGER(iwp) ::  mm               !:
+    INTEGER(iwp) ::  nest_overlap     !:
     INTEGER(iwp) ::  nomatch          !:
     INTEGER(iwp) ::  nx_cl            !:
@@ -546 +548 @@
     INTEGER(iwp), DIMENSION(5) ::  val    !:
 
+
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xl   !:
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xr   !:    
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_ys   !:
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_yn   !:
     REAL(wp) ::  dx_cl            !:
     REAL(wp) ::  dy_cl            !:
@@ -562 +569 @@
 
 !
-!-- Get coordinates from all clients
+!-- Corners of all children of the present parent
+    IF ( ( SIZE( pmc_server_for_client ) - 1 > 0 ) .AND. myid == 0 )  THEN 
+       ALLOCATE( ch_xl(1:SIZE( pmc_server_for_client ) - 1) )
+       ALLOCATE( ch_xr(1:SIZE( pmc_server_for_client ) - 1) )
+       ALLOCATE( ch_ys(1:SIZE( pmc_server_for_client ) - 1) )
+       ALLOCATE( ch_yn(1:SIZE( pmc_server_for_client ) - 1) )
+    ENDIF
+
+!
+!-- Get coordinates from all children
     DO  m = 1, SIZE( pmc_server_for_client ) - 1
 
@@ -589 +605 @@
 
 !    
-!--       Get absolute coordinates from the client
+!--       Get absolute coordinates from the child
           ALLOCATE( cl_coord_x(-nbgp:nx_cl+nbgp) )
           ALLOCATE( cl_coord_y(-nbgp:ny_cl+nbgp) )
@@ -624 +640 @@
           ENDIF
 
+!
+!--       Check that parallel nest domains, if any, do not overlap.
+          nest_overlap = 0
+          IF ( SIZE( pmc_server_for_client ) - 1 > 0 )  THEN
+             ch_xl(m) = cl_coord_x(-nbgp)
+             ch_xr(m) = cl_coord_x(nx_cl+nbgp)
+             ch_ys(m) = cl_coord_y(-nbgp)
+             ch_yn(m) = cl_coord_y(ny_cl+nbgp)
+
+             IF ( m > 1 )  THEN
+                DO mm = 1, m-1
+                   IF ( ( ch_xl(m) < ch_xr(mm) .OR. ch_xr(m) > ch_xl(mm) ) .AND.  &
+                        ( ch_ys(m) < ch_yn(mm) .OR. ch_yn(m) > ch_ys(mm) ) )  THEN                        
+                      nest_overlap = 1
+                   ENDIF
+                ENDDO
+             ENDIF
+          ENDIF
+
           DEALLOCATE( cl_coord_x )
           DEALLOCATE( cl_coord_y )
 
 !
-!--       Send coarse grid information to client
+!--       Send coarse grid information to child
           CALL pmc_send_to_client( client_id, define_coarse_grid_real,         &
                                    SIZE( define_coarse_grid_real ), 0, 21,     &
@@ -636 +671 @@
 
 !
-!--       Send local grid to client
+!--       Send local grid to child
           CALL pmc_send_to_client( client_id, coord_x, nx+1+2*nbgp, 0, 24,     &
                                    ierr )
@@ -653 +688 @@
        CALL MPI_BCAST( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr )
        IF ( nomatch /= 0 ) THEN
-          WRITE ( message_string, * )  'Error: nested client domain does ',    &
-                                       'not fit into its server domain'
-          CALL message( 'pmc_palm_setup_server', 'PA0XYZ', 1, 2, 0, 6, 0 )
+          WRITE ( message_string, * )  'Error: nested child domain does ',    &
+                                       'not fit into its parent domain'
+          CALL message( 'pmc_palm_setup_server', 'PA0425', 3, 2, 0, 6, 0 )
+       ENDIF
+  
+       CALL MPI_BCAST( nest_overlap, 1, MPI_INTEGER, 0, comm2d, ierr )
+       IF ( nest_overlap /= 0 ) THEN
+          WRITE ( message_string, * )  'Nested parallel child ',    &
+                                       'domains overlap'
+          CALL message( 'pmc_palm_setup_server', 'PA0426', 3, 2, 0, 6, 0 )
        ENDIF
       
@@ -674 +716 @@
        CALL pmc_s_setind_and_allocmem( client_id )
     ENDDO
+
+    IF ( ( SIZE( pmc_server_for_client ) - 1 > 0 ) .AND. myid == 0 )  THEN 
+       DEALLOCATE( ch_xl )
+       DEALLOCATE( ch_xr )
+       DEALLOCATE( ch_ys )
+       DEALLOCATE( ch_yn )
+    ENDIF
 
  CONTAINS
@@ -3088 +3137 @@
     ELSE
 
-       IF( nesting_datatransfer_mode == 'cascade' )  THEN
+       IF ( nesting_datatransfer_mode == 'cascade' )  THEN
 
           CALL pmci_client_datatrans( server_to_client )
@@ -3096 +3145 @@
           CALL pmci_client_datatrans( client_to_server )
 
-       ELSEIF( nesting_datatransfer_mode == 'overlap')  THEN
+       ELSEIF ( nesting_datatransfer_mode == 'overlap' )  THEN
 
           CALL pmci_server_datatrans( server_to_client )
@@ -3104 +3153 @@
           CALL pmci_server_datatrans( client_to_server )
 
-       ELSEIF( TRIM( nesting_datatransfer_mode ) == 'mixed' )  THEN
+       ELSEIF ( TRIM( nesting_datatransfer_mode ) == 'mixed' )  THEN
 
           CALL pmci_server_datatrans( server_to_client )
@@ -3917 +3966 @@
       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !:
       
-      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) ::  ic    !:
-      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) ::  jc    !:
-      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc    !:
+      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) ::  ic   !:
+      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) ::  jc   !:
+      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc   !:
       
       CHARACTER(LEN=1), INTENT(IN) :: var   !: