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

Timestamp:

Feb 27, 2020 3:24:30 PM (5 years ago)

Author:

raasch

Message:

serial (non-MPI) test case added, several bugfixes for the serial mode

File:

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

palm/trunk/SOURCE/poismg_mod.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! statement added to avoid compile error due to unused dummy argument
+! bugfix: cpp-directives added for serial mode
+! 
+! 4360 2020-01-07 11:25:50Z suehring
 ! Corrected "Former revisions" section
 ! 
@@ -1210 +1214 @@
 !> Gather subdomain data from all PEs.
 !------------------------------------------------------------------------------!
+#if defined( __parallel )
     SUBROUTINE mg_gather( f2, f2_sub )
 
@@ -1244 +1249 @@
 
 
-#if defined( __parallel )
        CALL cpu_log( log_point_s(34), 'mg_gather', 'start' )
 
@@ -1279 +1283 @@
 
        CALL cpu_log( log_point_s(34), 'mg_gather', 'stop' )
-#endif
     
     END SUBROUTINE mg_gather
-
+#endif
 
 
@@ -1291 +1294 @@
 !>       non-blocking communication
 !------------------------------------------------------------------------------!
+#if defined( __parallel )
     SUBROUTINE mg_scatter( p2, p2_sub )
 
@@ -1303 +1307 @@
 
        IMPLICIT NONE
-
-       INTEGER(iwp) ::  nwords  !<
 
        REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,                         &
@@ -1314 +1316 @@
                            mg_loc_ind(1,myid)-1:mg_loc_ind(2,myid)+1) ::  p2_sub  !<
 
-!
-!--    Find out the number of array elements of the subdomain array
-       nwords = SIZE( p2_sub )
-
-#if defined( __parallel )
+
        CALL cpu_log( log_point_s(35), 'mg_scatter', 'start' )
 
@@ -1325 +1323 @@
 
        CALL cpu_log( log_point_s(35), 'mg_scatter', 'stop' )
-#endif
     
     END SUBROUTINE mg_scatter
-
+#endif
 
 !------------------------------------------------------------------------------!
@@ -1383 +1380 @@
 
        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  f2_sub  !<
+
+#if defined( __parallel )
        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  p2_sub  !<
+#endif
 
 !
@@ -1472 +1472 @@
 !
 !--          Gather all arrays from the subdomains on PE0
+#if defined( __parallel )
              CALL mg_gather( f2, f2_sub )
+#endif
 
 !
@@ -1760 +1762 @@
 
        USE control_parameters,                                                 &
-           ONLY:  grid_level, mg_switch_to_pe0_level, synchronous_exchange
+           ONLY:  grid_level
+
+#if defined( __parallel )
+       USE control_parameters,                                                 &
+           ONLY:  mg_switch_to_pe0_level, synchronous_exchange
+#endif
 
        USE indices,                                                            &
-           ONLY:  nxl, nxl_mg, nxr, nxr_mg, nys, nys_mg, nyn,      &
-                  nyn_mg, nzb, nzt, nzt_mg
+           ONLY:  nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
+
+#if defined( __parallel )
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nys, nyn, nzt
+#endif
 
        IMPLICIT NONE
@@ -1773 +1784 @@
                                     p_mg   !< treated array
 
-       INTEGER(iwp), intent(IN) ::  color  !< flag for grid point type (red or black)
+       INTEGER(iwp), INTENT(IN) ::  color  !< flag for grid point type (red or black)
+
+#if defined ( __parallel )
 !
 !--    Local variables
@@ -1794 +1807 @@
        REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  temp  !< temporary array on next coarser grid level
 
-#if defined ( __parallel )
        synchronous_exchange_save   = synchronous_exchange
        synchronous_exchange        = .FALSE.
@@ -2261 +2273 @@
 
                 IF ( i == nxl_mg(l) )  THEN
-                   !DIR$ IVDEP
+                   !DIR$ IVDEP       INTEGER(iwp) ::  ngp       !<
+
                    DO  k = nzb+1, ind_even_odd
                       p_mg(k,j,nxr_mg(l)+1)  = temp(k,j1,ixr+1)
@@ -2299 +2312 @@
 
 !
+!--    Next line is to avoid compile error due to unused dummy argument
+       IF ( color == 1234567 )  RETURN
+!
 !--    Standard horizontal ghost boundary exchange for small coarse grid
 !--    levels, where the transfer time is latency bound