Index: palm/trunk/SOURCE/poismg.f90
===================================================================
--- palm/trunk/SOURCE/poismg.f90	(revision 708)
+++ palm/trunk/SOURCE/poismg.f90	(revision 778)
@@ -7,5 +7,6 @@
 ! Current revisions:
 ! -----------------
-! 
+! Allocation of p3 changes when multigrid is used and the collected field on PE0
+! has more grid points than the subdomain of an PE.
 !
 ! Former revisions:
@@ -75,5 +76,5 @@
     REAL    ::  maxerror, maximum_mgcycles, residual_norm
 
-    REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  r
+    REAL, DIMENSION(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) ::  r 
 
     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  p3
@@ -81,9 +82,18 @@
 
     CALL cpu_log( log_point_s(29), 'poismg', 'start' )
-
 !
 !-- Initialize arrays and variables used in this subroutine
-    ALLOCATE ( p3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
-
+
+!--    If the number of grid points of the gathered grid, which is collected
+!--    on PE0, is larger than the number of grid points of an PE, than array
+!--    p3 will be enlarged. 
+    IF ( gathered_size > subdomain_size )  THEN 
+       ALLOCATE( p3(nzb:nzt_mg(mg_switch_to_pe0_level)+1,nys_mg(         &
+                    mg_switch_to_pe0_level)-1:nyn_mg(mg_switch_to_pe0_level)+1,   &
+                    nxl_mg(mg_switch_to_pe0_level)-1:nxr_mg(                    &
+                    mg_switch_to_pe0_level)+1) )
+    ELSE
+       ALLOCATE ( p3(nzb:nzt+1,nys-1:nyn+1,nxl-1:nxr+1) )
+    ENDIF
 !
 !-- Ghost boundaries have to be added to divergence array.
@@ -111,7 +121,7 @@
     DO WHILE ( residual_norm > residual_limit  .OR. &
                mgcycles < maximum_mgcycles )
-
+ 
        CALL next_mg_level( d, p_loc, p3, r)
-        
+
 !
 !--    Calculate the residual if the user has not preset the number of
@@ -120,10 +130,11 @@
           CALL resid( d, p_loc, r )
           maxerror = SUM( r(nzb+1:nzt,nys:nyn,nxl:nxr)**2 )
+
 #if defined( __parallel )
           IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-          CALL MPI_ALLREDUCE( maxerror, residual_norm, 1, MPI_REAL, MPI_SUM, &
+             CALL MPI_ALLREDUCE( maxerror, residual_norm, 1, MPI_REAL, MPI_SUM, &
                               comm2d, ierr)
 #else
-          residual_norm = maxerror
+             residual_norm = maxerror
 #endif
           residual_norm = SQRT( residual_norm )
@@ -612,4 +623,5 @@
 
           IF ( .NOT. unroll )  THEN
+
              CALL cpu_log( log_point_s(36), 'redblack_no_unroll', 'start' )
 
@@ -964,4 +976,5 @@
     CALL exchange_horiz( p_mg, 1)
 
+
  END SUBROUTINE redblack
 
@@ -1107,4 +1120,5 @@
     REAL, DIMENSION(:,:,:), ALLOCATABLE ::  f2, f2_sub, p2, p2_sub
 
+
 !
 !-- Restriction to the coarsest grid
@@ -1115,6 +1129,9 @@
 !--    iterations in order to get a more accurate solution.
        ngsrb = 2 * ngsrb
+
        CALL redblack( f_mg, p_mg )
+
        ngsrb = ngsrb / 2
+
 
     ELSEIF ( grid_level /= 1 )  THEN
@@ -1137,6 +1154,6 @@
        grid_level = grid_level - 1
        nxl = nxl_mg(grid_level)
+       nys = nys_mg(grid_level)
        nxr = nxr_mg(grid_level)
-       nys = nys_mg(grid_level)
        nyn = nyn_mg(grid_level)
        nzt = nzt_mg(grid_level)
@@ -1150,4 +1167,5 @@
 
        IF ( grid_level == mg_switch_to_pe0_level )  THEN
+
 !
 !--       From this level on, calculations are done on PE0 only.
@@ -1156,4 +1174,5 @@
 !--       in between (otherwise, the restrict routine would expect
 !--       the gathered array)
+
           nxl_mg_save = nxl_mg(grid_level)
           nxr_mg_save = nxr_mg(grid_level)
@@ -1190,5 +1209,4 @@
           nyn = nyn_mg(grid_level)
           nzt = nzt_mg(grid_level)
-
 !
 !--       Gather all arrays from the subdomains on PE0
@@ -1231,5 +1249,4 @@
 
        ELSE
-
           CALL restrict( f2, r )
 
@@ -1334,5 +1351,4 @@
 
        ELSE
-
           CALL prolong( p2, p3 )
 
@@ -1360,4 +1376,5 @@
     ENDIF
 
+
 !
 !-- The following few lines serve the steering of the multigrid scheme 
