Changeset 4832 for palm/trunk/SOURCE/poismg_mod.f90

Timestamp:

Jan 7, 2021 7:15:12 AM (4 years ago)

Author:

raasch

Message:

bugfix in redblack algorithm: lower i,j indices need to start alternatively with even or odd value on the coarsest grid level, if the subdomain has an uneven number of gridpoints along x/y; some debug output flushed

File:

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

palm/trunk/SOURCE/poismg_mod.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! bugfix in redblack algorithm: lower i,j indices need to start alternatively with even or odd
+! value on the coarsest grid level, if the subdomain has an uneven number of gridpoints along x/y
+!
+! 4828 2021-01-05 11:21:41Z Giersch
 ! File re-formatted to follow the PALM coding standard
 !
@@ -742 +746 @@
     INTEGER(iwp) ::  l      !< grid level
     INTEGER(iwp) ::  n      !< loop variable Gauß-Seidel iterations
-
-
-    LOGICAL ::  unroll  !< flag indicating whether loop unrolling is possible
+    INTEGER(iwp) ::  save_nxl_mg  !< to save nxl_mg on coarsest level 1
+    INTEGER(iwp) ::  save_nys_mg  !< to save nys_mg on coarsest level 1
+
+
+    LOGICAL ::  adjust_lower_i_index  !< adjust lower limit of i loop in case of odd number of grid points
+    LOGICAL ::  adjust_lower_j_index  !< adjust lower limit of j loop in case of odd number of grid points
+    LOGICAL ::  unroll                !< flag indicating whether loop unrolling is possible
 
     REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,nys_mg(grid_level)-1:nyn_mg(grid_level)+1,        &
@@ -751 +759 @@
                         nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !< perturbation pressure
 
+
     l = grid_level
 
     unroll = ( MOD( nyn_mg(l)-nys_mg(l)+1, 4 ) == 0  .AND.  MOD( nxr_mg(l)-nxl_mg(l)+1, 2 ) == 0 )
 
+!
+!-- The red/black decomposition requires that on the lower i,j indices need to start alternatively with an
+!-- even or odd value on the coarsest grid level, depending on the core-id, and if the subdomain has an
+!-- uneven number of gridpoints along x/y. Set the respective steering switches here.
+    IF ( l == 1  .AND.  MOD( myidx, 2 ) /= 0  .AND.  MOD( nxl_mg(l) - nxr_mg(l), 2 ) == 0 )  THEN
+       adjust_lower_i_index = .TRUE.
+       save_nxl_mg = nxl_mg(1)
+    ELSE
+       adjust_lower_i_index = .FALSE.
+    ENDIF
+    IF ( l == 1  .AND.  MOD( myidy, 2 ) /= 0  .AND.  MOD( nyn_mg(l) - nys_mg(l), 2 ) == 0 )  THEN
+       adjust_lower_j_index = .TRUE.
+       save_nys_mg = nys_mg(l)
+    ELSE
+       adjust_lower_j_index = .FALSE.
+    ENDIF
+
+
     DO  n = 1, ngsrb
 
@@ -762 +789 @@
 
              CALL cpu_log( log_point_s(36), 'redblack_no_unroll_f', 'start' )
+
+             IF ( adjust_lower_i_index )  THEN
+                nxl_mg(l) = save_nxl_mg + 1
+             ENDIF
+
+             IF ( adjust_lower_j_index )  THEN
+                IF ( color == 1 )  THEN
+                  nys_mg(l) = save_nys_mg - 1
+                ELSE
+                  nys_mg(l) = save_nys_mg + 1
+                ENDIF
+             ENDIF
 !
 !--          Without unrolling of loops, no cache optimization
@@ -784 +823 @@
              ENDDO
 
+             IF ( adjust_lower_i_index )  THEN
+                nxl_mg(l) = save_nxl_mg - 1
+             ENDIF
+
+             IF ( adjust_lower_j_index )  THEN
+                IF ( color == 1 )  THEN
+                  nys_mg(l) = save_nys_mg + 1
+                ELSE
+                  nys_mg(l) = save_nys_mg - 1
+                ENDIF
+             ENDIF
+
              !$OMP DO
              DO  i = nxl_mg(l)+1, nxr_mg(l), 2
@@ -803 +854 @@
              ENDDO
 
+             IF ( adjust_lower_i_index )  THEN
+                nxl_mg(l) = save_nxl_mg + 1
+             ENDIF
+
+             IF ( adjust_lower_j_index )  THEN
+                IF ( color == 1 )  THEN
+                  nys_mg(l) = save_nys_mg + 1
+                ELSE
+                  nys_mg(l) = save_nys_mg - 1
+                ENDIF
+             ENDIF
+
              !$OMP DO
              DO  i = nxl_mg(l), nxr_mg(l), 2
@@ -821 +884 @@
                 ENDDO
              ENDDO
+
+             IF ( adjust_lower_i_index )  THEN
+                nxl_mg(l) = save_nxl_mg - 1
+             ENDIF
+
+             IF ( adjust_lower_j_index )  THEN
+                IF ( color == 1 )  THEN
+                  nys_mg(l) = save_nys_mg - 1
+                ELSE
+                  nys_mg(l) = save_nys_mg + 1
+                ENDIF
+             ENDIF
 
              !$OMP DO
@@ -1013 +1088 @@
     ENDDO
 
+!
+!-- Reset lower index limits to their standard values (may happen on coarsest levels only)
+    IF ( adjust_lower_i_index )  THEN
+       nxl_mg(l) = save_nxl_mg
+    ENDIF
+
+    IF ( adjust_lower_j_index )  THEN
+       nys_mg(l) = save_nys_mg
+    ENDIF
+
+
  END SUBROUTINE redblack