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

Timestamp:

Jan 7, 2021 7:15:12 AM (3 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_noopt_mod.f90 (modified) (8 diffs)

palm/trunk/SOURCE/poismg_noopt_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
-!
 !
 ! 4457 2020-03-11 14:20:43Z raasch
@@ -801 +804 @@
     IMPLICIT NONE
 
-    INTEGER(iwp) :: color  !<
-    INTEGER(iwp) :: i      !<
-    INTEGER(iwp) :: ic     !<
-    INTEGER(iwp) :: j      !<
-    INTEGER(iwp) :: jc     !<
-    INTEGER(iwp) :: jj     !<
-    INTEGER(iwp) :: k      !<
-    INTEGER(iwp) :: l      !<
-    INTEGER(iwp) :: n      !<
-
+    INTEGER(iwp) ::  color  !<
+    INTEGER(iwp) ::  i      !<
+    INTEGER(iwp) ::  ic     !<
+    INTEGER(iwp) ::  j      !<
+    INTEGER(iwp) ::  jc     !<
+    INTEGER(iwp) ::  jj     !<
+    INTEGER(iwp) ::  k      !<
+    INTEGER(iwp) ::  l      !<
+    INTEGER(iwp) ::  n      !<
+    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  !<
 
@@ -855 +862 @@
                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
 
@@ -863 +888 @@
              CALL cpu_log( log_point_s(36), 'redblack_no_unroll_noopt', '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
@@ -897 +933 @@
                 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
 
              DO  i = nxl_mg(l)+1, nxr_mg(l), 2
@@ -924 +972 @@
              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
+
              DO  i = nxl_mg(l), nxr_mg(l), 2
                 DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
@@ -949 +1009 @@
                 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
 
              DO  i = nxl_mg(l)+1, nxr_mg(l), 2
@@ -1215 +1287 @@
 
 !
-!--    Set pressure within topography and at the topography surfaces
+!-- 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
+
+!
+!-- Set pressure within topography and at the topography surfaces
 !$OMP PARALLEL PRIVATE (i,j,k,wall_left,wall_north,wall_right,wall_south,wall_top,wall_total)
 !$OMP DO