Changeset 1898 for palm


Ignore:
Timestamp:
May 3, 2016 11:27:17 AM (9 years ago)
Author:
suehring
Message:

Bugfix: bottom and top boundary condition

File:
1 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/poismg_fast_mod.f90

    r1851 r1898  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! Bugfix: bottom and top boundary condition in resid_fast
     22! Bugfix: restriction at nzb+1
     23! formatting adjustments, variable descriptions added in some declaration blocks
    2224!
    2325! Former revisions:
     
    247249       USE control_parameters,                                                 &
    248250           ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
    249                   inflow_n, inflow_r, inflow_s, masking_method, nest_bound_l,  &
    250                   nest_bound_n, nest_bound_r, nest_bound_s, outflow_l,        &
    251                   outflow_n, outflow_r, outflow_s, topography
     251                  inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,    &
     252                  nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r, &
     253                  outflow_s
    252254
    253255       USE grid_variables,                                                     &
     
    255257
    256258       USE indices,                                                            &
    257            ONLY:  flags, wall_flags_1, wall_flags_2, wall_flags_3,             &
    258                   wall_flags_4, wall_flags_5, wall_flags_6, wall_flags_7,      &
    259                   wall_flags_8, wall_flags_9, wall_flags_10, nxl_mg, nxr_mg,   &
    260                   nys_mg, nyn_mg, nzb, nzt_mg
     259           ONLY:  nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
    261260
    262261       IMPLICIT NONE
    263262
    264        INTEGER(iwp) ::  i
    265        INTEGER(iwp) ::  j
    266        INTEGER(iwp) ::  k
    267        INTEGER(iwp) ::  l
    268        INTEGER(iwp) :: km1      !<
    269        INTEGER(iwp) :: kp1      !<
     263       INTEGER(iwp) ::  i        !< index variable along x
     264       INTEGER(iwp) ::  j        !< index variable along y
     265       INTEGER(iwp) ::  k        !< index variable along z
     266       INTEGER(iwp) ::  l        !< index indicating grid level
     267       INTEGER(iwp) ::  km1      !< index variable along z dimension (k-1)
     268       INTEGER(iwp) ::  kp1      !< index variable along z dimension (k+1)
    270269
    271270       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    272271                       nys_mg(grid_level)-1:nyn_mg(grid_level)+1,              &
    273                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !<
     272                       nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !< velocity divergence
    274273       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    275274                       nys_mg(grid_level)-1:nyn_mg(grid_level)+1,              &
    276                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !<
     275                       nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !< perturbation pressure
    277276       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    278277                       nys_mg(grid_level)-1:nyn_mg(grid_level)+1,              &
    279                        nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  r     !<
     278                       nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  r     !< residuum of perturbation pressure
    280279
    281280!
     
    284283
    285284       CALL cpu_log( log_point_s(53), 'resid', 'start' )
    286        IF ( topography == 'flat'  .OR.  masking_method )  THEN
    287           !$OMP PARALLEL PRIVATE (i,j,k,km1,kp1)
    288           !$OMP DO
    289           DO  i = nxl_mg(l), nxr_mg(l)
    290              DO  j = nys_mg(l), nyn_mg(l)
     285       !$OMP PARALLEL PRIVATE (i,j,k,km1,kp1)
     286       !$OMP DO
     287       DO  i = nxl_mg(l), nxr_mg(l)
     288          DO  j = nys_mg(l), nyn_mg(l)
    291289                !DIR$ IVDEP
    292                 DO k = ind_even_odd+1, nzt_mg(l)
    293                    km1 = k-ind_even_odd-1
    294                    kp1 = k-ind_even_odd
    295                    r(k,j,i) = f_mg(k,j,i)                                 &
    296                       - ddx2_mg(l) *                                      &
    297                       ( p_mg(k,j,i+1) +  p_mg(k,j,i-1)  )                 &
    298                       - ddy2_mg(l) *                                      &
    299                       ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )                  &
    300                       - f2_mg_b(k,l) * p_mg(kp1,j,i)                      &
    301                       - f3_mg_b(k,l) * p_mg(km1,j,i)                      &
     290             DO k = ind_even_odd+1, nzt_mg(l)
     291                km1 = k-ind_even_odd-1
     292                kp1 = k-ind_even_odd
     293                r(k,j,i) = f_mg(k,j,i)                                         &
     294                      - ddx2_mg(l) *                                           &
     295                      ( p_mg(k,j,i+1) +  p_mg(k,j,i-1)  )                      &
     296                      - ddy2_mg(l) *                                           &
     297                      ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )                       &
     298                      - f2_mg_b(k,l) * p_mg(kp1,j,i)                           &
     299                      - f3_mg_b(k,l) * p_mg(km1,j,i)                           &
    302300                      + f1_mg_b(k,l) * p_mg(k,j,i)
    303                 ENDDO
    304                 !DIR$ IVDEP
    305                 DO k = nzb+1, ind_even_odd
    306                    km1 = k+ind_even_odd
    307                    kp1 = k+ind_even_odd+1
    308                    r(k,j,i) = f_mg(k,j,i)                                 &
    309                       - ddx2_mg(l) *                                      &
    310                       ( p_mg(k,j,i+1) +  p_mg(k,j,i-1)  )                 &
    311                       - ddy2_mg(l) *                                      &
    312                       ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )                  &
    313                       - f2_mg_b(k,l) * p_mg(kp1,j,i)                      &
    314                       - f3_mg_b(k,l) * p_mg(km1,j,i)                      &
     301             ENDDO
     302             !DIR$ IVDEP
     303             DO k = nzb+1, ind_even_odd
     304                km1 = k+ind_even_odd
     305                kp1 = k+ind_even_odd+1
     306                r(k,j,i) = f_mg(k,j,i)                                         &
     307                      - ddx2_mg(l) *                                           &
     308                      ( p_mg(k,j,i+1) +  p_mg(k,j,i-1)  )                      &
     309                      - ddy2_mg(l) *                                           &
     310                      ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )                       &
     311                      - f2_mg_b(k,l) * p_mg(kp1,j,i)                           &
     312                      - f3_mg_b(k,l) * p_mg(km1,j,i)                           &
    315313                      + f1_mg_b(k,l) * p_mg(k,j,i)
    316                 ENDDO
    317              ENDDO
    318           ENDDO
    319           !$OMP END PARALLEL
    320        ELSE
    321 !
    322 !--       Choose flag array of this level
    323           SELECT CASE ( l )
    324              CASE ( 1 )
    325                 flags => wall_flags_1
    326              CASE ( 2 )
    327                 flags => wall_flags_2
    328              CASE ( 3 )
    329                 flags => wall_flags_3
    330              CASE ( 4 )
    331                 flags => wall_flags_4
    332              CASE ( 5 )
    333                 flags => wall_flags_5
    334              CASE ( 6 )
    335                 flags => wall_flags_6
    336              CASE ( 7 )
    337                 flags => wall_flags_7
    338              CASE ( 8 )
    339                 flags => wall_flags_8
    340              CASE ( 9 )
    341                 flags => wall_flags_9
    342              CASE ( 10 )
    343                 flags => wall_flags_10
    344           END SELECT
    345 
    346           !$OMP PARALLEL PRIVATE (i,j,k,km1,kp1)
    347           !$OMP DO
    348           DO  i = nxl_mg(l), nxr_mg(l)
    349              DO  j = nys_mg(l), nyn_mg(l)
    350 
    351                 !DIR$ IVDEP
    352                 DO  k = ind_even_odd+1, nzt_mg(l)
    353                    km1 = k-ind_even_odd-1
    354                    kp1 = k-ind_even_odd
    355 
    356                    r(k,j,i) = f_mg(k,j,i)                                         &
    357                     - ddx2_mg(l) *                                                &
    358                     ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5 ))   &
    359                     + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4 )) ) &
    360                     - ddy2_mg(l)                                                  &
    361                     * ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3 )) &
    362                     + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2 )) ) &
    363                     - f2_mg(k,l) * p_mg(kp1,j,i)                                  &
    364                     - f3_mg(k,l) *                                                &
    365                       MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0 ))   &
    366                     + f1_mg(k,l) * p_mg(k,j,i)
    367                 ENDDO
    368 
    369                 !DIR$ IVDEP
    370                 DO  k = nzb+1, ind_even_odd
    371                    km1 = k+ind_even_odd
    372                    kp1 = k+ind_even_odd+1
    373 
    374                    r(k,j,i) = f_mg(k,j,i)                                         &
    375                     - ddx2_mg(l) *                                                &
    376                     ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5 ))   &
    377                     + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4 )) ) &
    378                     - ddy2_mg(l)                                                  &
    379                     * ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3 )) &
    380                     + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2 )) ) &
    381                     - f2_mg(k,l) * p_mg(kp1,j,i)                                  &
    382                     - f3_mg(k,l) *                                                &
    383                       MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0 ))   &
    384                     + f1_mg(k,l) * p_mg(k,j,i)
    385                 ENDDO
    386 !
    387 !--             The residual within topography should be zero
    388                 WHERE( BTEST(flags(nzb+1:nzt_mg(l),j,i), 6) )
    389                    r(nzb+1:nzt_mg(l),j,i) = 0.0
    390                 END WHERE
    391 
    392              ENDDO
    393           ENDDO
    394           !$OMP END PARALLEL
    395 
    396        ENDIF
    397 
     314             ENDDO
     315          ENDDO
     316       ENDDO
     317       !$OMP END PARALLEL
    398318!
    399319!--    Horizontal boundary conditions
     
    419339
    420340!
    421 !--    Boundary conditions at bottom and top of the domain.outflow_l, outflow_n,
    422 !--    These points are not handled by the above loop. Points may be within
     341!--    Boundary conditions at bottom and top of the domain. Points may be within
    423342!--    buildings, but that doesn't matter.
    424343       IF ( ibc_p_b == 1 )  THEN
    425           r(nzb,:,: ) = r(nzb+1,:,:)
     344!
     345!--       equivalent to r(nzb,:,: ) = r(nzb+1,:,:)
     346          r(nzb,:,: ) = r(ind_even_odd+1,:,:)
    426347       ELSE
    427348          r(nzb,:,: ) = 0.0_wp
     
    429350
    430351       IF ( ibc_p_t == 1 )  THEN
    431           r(nzt_mg(l)+1,:,: ) = r(nzt_mg(l),:,:)
     352!
     353!--       equivalent to r(nzt_mg(l)+1,:,: ) = r(nzt_mg(l),:,:)
     354          r(nzt_mg(l)+1,:,: ) = r(ind_even_odd,:,:)
    432355       ELSE
    433356          r(nzt_mg(l)+1,:,: ) = 0.0_wp
     
    450373       USE control_parameters,                                                 &
    451374           ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
    452                   inflow_n, inflow_r, inflow_s, masking_method, nest_bound_l,  &
    453                   nest_bound_n, nest_bound_r, nest_bound_s, outflow_l,        &
    454                   outflow_n, outflow_r, outflow_s, topography
     375                  inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,    &
     376                  nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r, &
     377                  outflow_s
    455378
    456379       USE indices,                                                            &
    457            ONLY:  flags, wall_flags_1, wall_flags_2, wall_flags_3,             &
    458                   wall_flags_4, wall_flags_5, wall_flags_6, wall_flags_7,      &
    459                   wall_flags_8, wall_flags_9, wall_flags_10, nxl_mg, nxr_mg,   &
    460                   nys_mg, nyn_mg, nzb, nzt_mg
     380           ONLY:  nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
    461381
    462382       IMPLICIT NONE
    463383
    464        INTEGER(iwp) ::  i    !<
    465        INTEGER(iwp) ::  ic   !<
    466        INTEGER(iwp) ::  j    !<
    467        INTEGER(iwp) ::  jc   !<
    468        INTEGER(iwp) ::  k    !<
    469        INTEGER(iwp) ::  kc   !<
    470        INTEGER(iwp) ::  l    !<
    471        INTEGER(iwp) ::  km1  !<
    472        INTEGER(iwp) ::  kp1  !<
    473 
    474        REAL(wp) ::  rkjim    !<
    475        REAL(wp) ::  rkjip    !<
    476        REAL(wp) ::  rkjmi    !<
    477        REAL(wp) ::  rkjmim   !<
    478        REAL(wp) ::  rkjmip   !<
    479        REAL(wp) ::  rkjpi    !<
    480        REAL(wp) ::  rkjpim   !<
    481        REAL(wp) ::  rkjpip   !<
    482        REAL(wp) ::  rkmji    !<
    483        REAL(wp) ::  rkmjim   !<
    484        REAL(wp) ::  rkmjip   !<
    485        REAL(wp) ::  rkmjmi   !<
    486        REAL(wp) ::  rkmjmim  !<
    487        REAL(wp) ::  rkmjmip  !<
    488        REAL(wp) ::  rkmjpi   !<
    489        REAL(wp) ::  rkmjpim  !<
    490        REAL(wp) ::  rkmjpip  !<
     384       INTEGER(iwp) ::  i    !< index variable along x on finer grid
     385       INTEGER(iwp) ::  ic   !< index variable along x on coarser grid
     386       INTEGER(iwp) ::  j    !< index variable along y on finer grid
     387       INTEGER(iwp) ::  jc   !< index variable along y on coarser grid
     388       INTEGER(iwp) ::  k    !< index variable along z on finer grid
     389       INTEGER(iwp) ::  kc   !< index variable along z on coarser grid
     390       INTEGER(iwp) ::  l    !< index indicating finer grid level
     391       INTEGER(iwp) ::  km1  !< index variable along z dimension (k-1 on finer level)
     392       INTEGER(iwp) ::  kp1  !< index variable along z dimension (k+1 on finer level)
     393
    491394
    492395       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    493396                           nys_mg(grid_level)-1:nyn_mg(grid_level)+1,          &
    494                            nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !<
     397                           nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::       &
     398                                         f_mg  !< Residual on coarser grid level
    495399
    496400       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level+1)+1,                         &
    497401                           nys_mg(grid_level+1)-1:nyn_mg(grid_level+1)+1,      &
    498                            nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) ::  r !<
     402                           nxl_mg(grid_level+1)-1:nxr_mg(grid_level+1)+1) ::   &
     403                                         r !< Residual on finer grid level
    499404
    500405!
     
    503408
    504409       CALL cpu_log( log_point_s(54), 'restrict', 'start' )
    505 
    506        IF ( topography == 'flat'  .OR.  masking_method )  THEN
    507 !
    508 !--       No wall treatment
    509           !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc,km1,kp1)
    510           DO  ic = nxl_mg(l), nxr_mg(l)
    511              i = 2*ic
    512              !$OMP DO SCHEDULE( STATIC )
    513              DO  jc = nys_mg(l), nyn_mg(l)
    514 !
    515 !--             Calculation for the first point along k
    516                 j  = 2*jc
    517                 k   = ind_even_odd+1
     410!
     411!--    No wall treatment
     412       !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc,km1,kp1)
     413       DO  ic = nxl_mg(l), nxr_mg(l)
     414          i = 2*ic
     415          !$OMP DO SCHEDULE( STATIC )
     416          DO  jc = nys_mg(l), nyn_mg(l)
     417!
     418!--          Calculation for the first point along k
     419             j  = 2*jc
     420!
     421!--          Calculation for the other points along k
     422             !DIR$ IVDEP
     423             DO k = ind_even_odd+1, nzt_mg(l+1)    ! Fine grid at this point
     424                km1 = k-ind_even_odd-1
    518425                kp1 = k-ind_even_odd
    519                 kc  = k-ind_even_odd
    520                 f_mg(kc,jc,ic) =  1.0_wp / 64.0_wp * (                         &
    521                                   8.0_wp * r(k,j,i)                            &
    522                                +  4.0_wp * ( r(k,j,i-1)     + r(k,j,i+1)     + &
    523                                              r(k,j+1,i)     + r(k,j-1,i)     ) &
    524                                +  2.0_wp * ( r(k,j-1,i-1)   + r(k,j+1,i-1)   + &
    525                                              r(k,j-1,i+1)   + r(k,j+1,i+1)   ) &
    526                                + 16.0_wp * r(k,j,i)                            &
    527                                +  4.0_wp * r(kp1,j,i)                          &
    528                                +  2.0_wp * ( r(kp1,j,i-1)   + r(kp1,j,i+1)   + &
    529                                              r(kp1,j+1,i)   + r(kp1,j-1,i)   ) &
    530                                +           ( r(kp1,j-1,i-1) + r(kp1,j+1,i-1) + &
    531                                              r(kp1,j-1,i+1) + r(kp1,j+1,i+1) ) &
    532                                                       )
    533 !
    534 !--             Calculation for the other points along k
    535                 !DIR$ IVDEP
    536                 DO k = ind_even_odd+2, nzt_mg(l+1)    ! Fine grid at this point
    537                    km1 = k-ind_even_odd-1
    538                    kp1 = k-ind_even_odd
    539                    kc  = k-ind_even_odd               ! Coarse grid index
    540 
    541                    f_mg(kc,jc,ic) = 1.0_wp / 64.0_wp * (                      &
    542                                   8.0_wp * r(k,j,i)                            &
    543                                 + 4.0_wp * ( r(k,j,i-1)     + r(k,j,i+1)     + &
    544                                              r(k,j+1,i)     + r(k,j-1,i)     ) &
    545                                 + 2.0_wp * ( r(k,j-1,i-1)   + r(k,j+1,i-1)   + &
    546                                              r(k,j-1,i+1)   + r(k,j+1,i+1)   ) &
    547                                 + 4.0_wp * r(km1,j,i)                          &
    548                                 + 2.0_wp * ( r(km1,j,i-1)   + r(km1,j,i+1)   + &
    549                                              r(km1,j+1,i)   + r(km1,j-1,i)   ) &
    550                                 +          ( r(km1,j-1,i-1) + r(km1,j+1,i-1) + &
    551                                              r(km1,j-1,i+1) + r(km1,j+1,i+1) ) &
    552                                 + 4.0_wp * r(kp1,j,i)                          &
    553                                 + 2.0_wp * ( r(kp1,j,i-1)   + r(kp1,j,i+1)   + &
    554                                              r(kp1,j+1,i)   + r(kp1,j-1,i)   ) &
    555                                 +          ( r(kp1,j-1,i-1) + r(kp1,j+1,i-1) + &
    556                                              r(kp1,j-1,i+1) + r(kp1,j+1,i+1) ) &
    557                                            )
    558                 ENDDO
    559              ENDDO
    560              !$OMP ENDDO nowait
    561           ENDDO
    562           !$OMP END PARALLEL
    563 
    564        ELSE
    565 !
    566 !--       Choose flag array of the upper level
    567           SELECT CASE ( l+1 )
    568              CASE ( 1 )
    569                 flags => wall_flags_1
    570              CASE ( 2 )
    571                 flags => wall_flags_2
    572              CASE ( 3 )
    573                 flags => wall_flags_3
    574              CASE ( 4 )
    575                 flags => wall_flags_4
    576              CASE ( 5 )
    577                 flags => wall_flags_5
    578              CASE ( 6 )
    579                 flags => wall_flags_6
    580              CASE ( 7 )
    581                 flags => wall_flags_7
    582              CASE ( 8 )
    583                 flags => wall_flags_8
    584              CASE ( 9 )
    585                 flags => wall_flags_9
    586              CASE ( 10 )
    587                 flags => wall_flags_10
    588           END SELECT
    589    
    590           !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,kc,km1,kp1,rkjim,rkjip,rkjpi,    &
    591           !$OMP                   rkjmim,rkjpim,rkjmip,rkjpip,rkmji,rkmjim,    &
    592           !$OMP                   rkmjip,rkmjpi,rkmjmi,rkmjmim,rkmjpim,        &
    593           !$OMP                   rkmjmip,rkmjpip)
    594           !$OMP DO
    595           DO  ic = nxl_mg(l), nxr_mg(l)
    596              i = 2*ic
    597              DO  jc = nys_mg(l), nyn_mg(l)
    598                 j = 2*jc
    599                 !DIR$ IVDEP
    600                 DO k = ind_even_odd+1, nzt_mg(l+1)      !fine grid at this point
    601 
    602                     km1 = k-ind_even_odd-1
    603                     kp1 = k-ind_even_odd
    604                     kc  = k-ind_even_odd                !Coarse grid index
    605 !
    606 !--                 Use implicit Neumann BCs if the respective gridpoint is
    607 !--                 inside the building
    608                     rkjim   = MERGE(r(k,j,i),r(k,j,i-1),BTEST( flags(k,j,i-1), 6))
    609                     rkjip   = MERGE(r(k,j,i),r(k,j,i+1),BTEST( flags(k,j,i+1), 6))
    610                     rkjpi   = MERGE(r(k,j,i),r(k,j+1,i),BTEST( flags(k,j+1,i), 6))
    611                     rkjmi   = MERGE(r(k,j,i),r(k,j-1,i),BTEST( flags(k,j-1,i), 6))
    612 
    613                     rkjmim  = MERGE(r(k,j,i),r(k,j-1,i-1),BTEST( flags(k,j-1,i-1), 6))
    614                     rkjpim  = MERGE(r(k,j,i),r(k,j+1,i-1),BTEST( flags(k,j+1,i-1), 6))
    615                     rkjmip  = MERGE(r(k,j,i),r(k,j-1,i+1),BTEST( flags(k,j-1,i+1), 6))
    616                     rkjpip  = MERGE(r(k,j,i),r(k,j+1,i+1),BTEST( flags(k,j+1,i+1), 6))
    617 
    618                     rkmji   = MERGE(r(k,j,i),r(km1,j,i)  ,BTEST( flags(km1,j,i)  , 6))
    619                     rkmjim  = MERGE(r(k,j,i),r(km1,j,i-1),BTEST( flags(km1,j,i-1), 6))
    620                     rkmjip  = MERGE(r(k,j,i),r(km1,j,i+1),BTEST( flags(km1,j,i+1), 6))
    621                     rkmjpi  = MERGE(r(k,j,i),r(km1,j+1,i),BTEST( flags(km1,j+1,i), 6))
    622                     rkmjmi  = MERGE(r(k,j,i),r(km1,j-1,i),BTEST( flags(km1,j-1,i), 6))
    623 
    624                     rkmjmim = MERGE(r(k,j,i),r(km1,j-1,i-1),BTEST( flags(km1,j-1,i-1), 6))
    625                     rkmjpim = MERGE(r(k,j,i),r(km1,j+1,i-1),BTEST( flags(km1,j+1,i-1), 6))
    626                     rkmjmip = MERGE(r(k,j,i),r(km1,j-1,i+1),BTEST( flags(km1,j-1,i+1), 6))
    627                     rkmjpip = MERGE(r(k,j,i),r(km1,j+1,i+1),BTEST( flags(km1,j+1,i+1), 6))
    628 
    629                     f_mg(kc,jc,ic) = 1.0_wp / 64.0_wp * (                      &
    630                            8.0_wp * r(k,j,i)                                   &
    631                          + 4.0_wp * ( rkjim   + rkjip   +  rkjpi   + rkjmi   ) &
    632                          + 2.0_wp * ( rkjmim  + rkjpim  +  rkjmip  + rkjpip  ) &
    633                          + 4.0_wp * rkmji                                      &
    634                          + 2.0_wp * ( rkmjim  + rkmjip  +  rkmjpi  + rkmjmi  ) &
    635                          +          ( rkmjmim + rkmjpim +  rkmjmip + rkmjpip ) &
    636                          + 4.0_wp * r(kp1,j,i)                                 &
    637                          + 2.0_wp * ( r(kp1,j,i-1)   + r(kp1,j,i+1)   +        &
    638                                       r(kp1,j+1,i)   + r(kp1,j-1,i)   )        &
    639                          +          ( r(kp1,j-1,i-1) + r(kp1,j+1,i-1) +        &
    640                                       r(kp1,j-1,i+1) + r(kp1,j+1,i+1) )        &
    641                                                         )
    642                 ENDDO
    643              ENDDO
    644           ENDDO
    645           !$OMP END PARALLEL
    646 
    647        ENDIF
    648 
     426                kc  = k-ind_even_odd               ! Coarse grid index
     427
     428                f_mg(kc,jc,ic) = 1.0_wp / 64.0_wp * (                      &
     429                               8.0_wp * r(k,j,i)                            &
     430                             + 4.0_wp * ( r(k,j,i-1)     + r(k,j,i+1)     + &
     431                                          r(k,j+1,i)     + r(k,j-1,i)     ) &
     432                             + 2.0_wp * ( r(k,j-1,i-1)   + r(k,j+1,i-1)   + &
     433                                          r(k,j-1,i+1)   + r(k,j+1,i+1)   ) &
     434                             + 4.0_wp * r(km1,j,i)                          &
     435                             + 2.0_wp * ( r(km1,j,i-1)   + r(km1,j,i+1)   + &
     436                                          r(km1,j+1,i)   + r(km1,j-1,i)   ) &
     437                             +          ( r(km1,j-1,i-1) + r(km1,j+1,i-1) + &
     438                                          r(km1,j-1,i+1) + r(km1,j+1,i+1) ) &
     439                             + 4.0_wp * r(kp1,j,i)                          &
     440                             + 2.0_wp * ( r(kp1,j,i-1)   + r(kp1,j,i+1)   + &
     441                                          r(kp1,j+1,i)   + r(kp1,j-1,i)   ) &
     442                             +          ( r(kp1,j-1,i-1) + r(kp1,j+1,i-1) + &
     443                                          r(kp1,j-1,i+1) + r(kp1,j+1,i+1) ) &
     444                                        )
     445             ENDDO
     446          ENDDO
     447          !$OMP ENDDO nowait
     448       ENDDO
     449       !$OMP END PARALLEL
     450
     451!
     452!--    Ghost point exchange
     453       CALL exchange_horiz( f_mg, 1)
    649454!
    650455!--    Horizontal boundary conditions
    651        CALL exchange_horiz( f_mg, 1)
    652 
    653456       IF ( .NOT. bc_lr_cyc )  THEN
    654457          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
     
    672475!--    Boundary conditions at bottom and top of the domain.
    673476!--    These points are not handled by the above loop. Points may be within
    674 !--    buildings, but that doesn't matter.
     477!--    buildings, but that doesn't matter. Remark: f_mg is ordered sequentielly
     478!--    after interpolation on coarse grid (is ordered in odd-even blocks further
     479!--    below).
    675480       IF ( ibc_p_b == 1 )  THEN
    676481          f_mg(nzb,:,: ) = f_mg(nzb+1,:,:)
     
    687492       CALL cpu_log( log_point_s(54), 'restrict', 'stop' )
    688493!
    689 !--    Why do we need a sorting here?
     494!--    Since residual is in sequential order after interpolation, an additional
     495!--    sorting in odd-even blocks along z dimension is required at this point.
    690496       CALL sort_k_to_even_odd_blocks( f_mg , l)
    691497
     
    713519       IMPLICIT NONE
    714520
    715        INTEGER(iwp) ::  i   !<
    716        INTEGER(iwp) ::  j   !<
    717        INTEGER(iwp) ::  k   !<
    718        INTEGER(iwp) ::  l   !<
    719        INTEGER(iwp) ::  kp1 !<
    720        INTEGER(iwp) ::  ke  !< Index for prolog even
    721        INTEGER(iwp) ::  ko  !< Index for prolog odd
     521       INTEGER(iwp) ::  i   !< index variable along x on coarser grid level
     522       INTEGER(iwp) ::  j   !< index variable along y on coarser grid level
     523       INTEGER(iwp) ::  k   !< index variable along z on coarser grid level
     524       INTEGER(iwp) ::  l   !< index indicating finer grid level
     525       INTEGER(iwp) ::  kp1 !< index variable along z
     526       INTEGER(iwp) ::  ke  !< index for prolog even
     527       INTEGER(iwp) ::  ko  !< index for prolog odd
    722528
    723529       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level-1)+1,                         &
    724530                           nys_mg(grid_level-1)-1:nyn_mg(grid_level-1)+1,      &
    725                            nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) ::  p  !<
     531                           nxl_mg(grid_level-1)-1:nxr_mg(grid_level-1)+1 ) ::  &
     532                               p     !< perturbation pressure on coarser grid level
    726533
    727534       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    728535                           nys_mg(grid_level)-1:nyn_mg(grid_level)+1,          &
    729                            nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  temp  !<
     536                           nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::       &
     537                               temp  !< perturbation pressure on finer grid level
    730538
    731539
     
    772580                                                 p(kp1,j,i)   + p(kp1,j,i+1) + &
    773581                                                 p(kp1,j+1,i) + p(kp1,j+1,i+1) )
     582
    774583             ENDDO
    775584
     
    804613                                                 p(kp1,j,i)   + p(kp1,j,i+1) + &
    805614                                                 p(kp1,j+1,i) + p(kp1,j+1,i+1) )
     615
    806616             ENDDO
    807617
     
    836646!--    Bottom and top boundary conditions
    837647       IF ( ibc_p_b == 1 )  THEN
     648!
     649!--       equivalent to temp(nzb,:,: ) = temp(nzb+1,:,:)
    838650          temp(nzb,:,: ) = temp(ind_even_odd+1,:,:)
    839651       ELSE
     
    842654
    843655       IF ( ibc_p_t == 1 )  THEN
     656!
     657!--       equivalent to temp(nzt_mg(l)+1,:,: ) = temp(nzt_mg(l),:,:)
    844658          temp(nzt_mg(l)+1,:,: ) = temp(ind_even_odd,:,:)
    845659       ELSE
     
    866680       USE control_parameters,                                                 &
    867681           ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
    868                   inflow_n, inflow_r, inflow_s, masking_method, nest_bound_l,  &
    869                   nest_bound_n, nest_bound_r, nest_bound_s, ngsrb,             &
    870                   outflow_l, outflow_n, outflow_r, outflow_s, topography
     682                  inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,    &
     683                  nest_bound_r, nest_bound_s, ngsrb, outflow_l, outflow_n,     &
     684                  outflow_r, outflow_s
    871685
    872686       USE grid_variables,                                                     &
     
    874688
    875689       USE indices,                                                            &
    876            ONLY:  flags, wall_flags_1, wall_flags_2, wall_flags_3,             &
    877                   wall_flags_4, wall_flags_5, wall_flags_6, wall_flags_7,      &
    878                   wall_flags_8, wall_flags_9, wall_flags_10, nxl_mg, nxr_mg,   &
    879                   nys_mg, nyn_mg, nzb, nzt_mg
     690           ONLY:  nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
    880691
    881692       IMPLICIT NONE
    882693
    883        INTEGER(iwp) :: color    !<
    884        INTEGER(iwp) :: i        !<
    885        INTEGER(iwp) :: ic       !<
    886        INTEGER(iwp) :: j        !<
    887        INTEGER(iwp) :: jc       !<
    888        INTEGER(iwp) :: jj       !<
    889        INTEGER(iwp) :: k        !<
    890        INTEGER(iwp) :: l        !<
    891        INTEGER(iwp) :: n        !<
    892        INTEGER(iwp) :: km1      !<
    893        INTEGER(iwp) :: kp1      !<
    894 
    895        LOGICAL :: unroll        !<
    896 
    897        REAL(wp) ::  wall_left   !<
    898        REAL(wp) ::  wall_north  !<
    899        REAL(wp) ::  wall_right  !<
    900        REAL(wp) ::  wall_south  !<
    901        REAL(wp) ::  wall_total  !<
    902        REAL(wp) ::  wall_top    !<
     694       INTEGER(iwp) :: color    !< grid point color, either red or black
     695       INTEGER(iwp) :: i        !< index variable along x
     696       INTEGER(iwp) :: ic       !< index variable along x
     697       INTEGER(iwp) :: j        !< index variable along y
     698       INTEGER(iwp) :: jc       !< index variable along y
     699       INTEGER(iwp) :: jj       !< index variable along y
     700       INTEGER(iwp) :: k        !< index variable along z
     701       INTEGER(iwp) :: l        !< grid level
     702       INTEGER(iwp) :: n        !< loop variable Gauß-Seidel iterations
     703       INTEGER(iwp) :: km1      !< index variable (k-1)
     704       INTEGER(iwp) :: kp1      !< index variable (k+1)
     705
     706       LOGICAL      :: unroll   !< flag indicating whether loop unrolling is possible
    903707
    904708       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    905709                           nys_mg(grid_level)-1:nyn_mg(grid_level)+1,          &
    906                            nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  f_mg  !<
     710                           nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::       &
     711                                      f_mg  !< residual of perturbation pressure
    907712       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    908713                           nys_mg(grid_level)-1:nyn_mg(grid_level)+1,          &
    909                            nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !<
     714                           nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::       &
     715                                      p_mg  !< perturbation pressure
    910716
    911717       l = grid_level
    912718
    913 !
    914 !--    Choose flag array of this level
    915        IF ( topography /= 'flat'  .AND.  .NOT. masking_method )  THEN
    916 
    917           SELECT CASE ( l )
    918              CASE ( 1 )
    919                 flags => wall_flags_1
    920              CASE ( 2 )
    921                 flags => wall_flags_2
    922              CASE ( 3 )
    923                 flags => wall_flags_3
    924              CASE ( 4 )
    925                 flags => wall_flags_4
    926              CASE ( 5 )
    927                 flags => wall_flags_5
    928              CASE ( 6 )
    929                 flags => wall_flags_6
    930              CASE ( 7 )
    931                 flags => wall_flags_7
    932              CASE ( 8 )
    933                 flags => wall_flags_8
    934              CASE ( 9 )
    935                 flags => wall_flags_9
    936              CASE ( 10 )
    937                 flags => wall_flags_10
    938           END SELECT
    939 
    940        ENDIF
    941 
    942        unroll = ( MOD( nyn_mg(l)-nys_mg(l)+1, 4 ) == 0  .AND. &
     719       unroll = ( MOD( nyn_mg(l)-nys_mg(l)+1, 4 ) == 0  .AND.                  &
    943720                  MOD( nxr_mg(l)-nxl_mg(l)+1, 2 ) == 0 )
    944721
     
    946723       
    947724          DO  color = 1, 2
    948 !
    949 !--          No wall treatment in case of flat topography
    950              IF ( topography == 'flat'  .OR.  masking_method )  THEN
    951 
    952                 IF ( .NOT. unroll )  THEN
    953 
    954                    CALL cpu_log( log_point_s(36), 'redblack_no_unroll_f', 'start' )
    955 !
    956 !--                Without unrolling of loops, no cache optimization
    957                    !$OMP PARALLEL PRIVATE (i,j,k,km1,kp1)
    958                    !$OMP DO
    959                    DO  i = nxl_mg(l), nxr_mg(l), 2
    960                       DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
    961                          !DIR$ IVDEP
    962                          DO  k = ind_even_odd+1, nzt_mg(l)
    963                             km1 = k-ind_even_odd-1
    964                             kp1 = k-ind_even_odd
    965                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    966                                ddx2_mg(l) *                                    &
    967                                ( p_mg(k,j,i+1) + p_mg(k,j,i-1)  )              &
    968                                + ddy2_mg(l) *                                  &
    969                                ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )              &
    970                                + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    971                                + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    972                                - f_mg(k,j,i)               )
    973                          ENDDO
    974                       ENDDO
    975                    ENDDO
    976    
    977                    !$OMP DO
    978                    DO  i = nxl_mg(l)+1, nxr_mg(l), 2
    979                       DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
    980                           !DIR$ IVDEP
    981                           DO  k = ind_even_odd+1, nzt_mg(l)
    982                             km1 = k-ind_even_odd-1
    983                             kp1 = k-ind_even_odd
    984                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    985                                ddx2_mg(l) *                                    &
    986                                ( p_mg(k,j,i+1) + p_mg(k,j,i-1)  )              &
    987                                + ddy2_mg(l) *                                  &
    988                                ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    989                                + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    990                                + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    991                                - f_mg(k,j,i)               )
    992                          ENDDO
    993                       ENDDO
    994                    ENDDO
    995  
    996                    !$OMP DO
    997                    DO  i = nxl_mg(l), nxr_mg(l), 2
    998                       DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
    999                          !DIR$ IVDEP
    1000                          DO  k = nzb+1, ind_even_odd
    1001                             km1 = k+ind_even_odd
    1002                             kp1 = k+ind_even_odd+1
    1003                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1004                                ddx2_mg(l) *                                    &
     725
     726             IF ( .NOT. unroll )  THEN
     727
     728                CALL cpu_log( log_point_s(36), 'redblack_no_unroll_f', 'start' )
     729!
     730!--             Without unrolling of loops, no cache optimization
     731                !$OMP PARALLEL PRIVATE (i,j,k,km1,kp1)
     732                !$OMP DO
     733                DO  i = nxl_mg(l), nxr_mg(l), 2
     734                   DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
     735                      !DIR$ IVDEP
     736                      DO  k = ind_even_odd+1, nzt_mg(l)
     737                         km1 = k-ind_even_odd-1
     738                         kp1 = k-ind_even_odd
     739                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     740                                 ddx2_mg(l) *                                  &
    1005741                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1006742                               + ddy2_mg(l) *                                  &
     
    1008744                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1009745                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1010                                - f_mg(k,j,i)               )
    1011                          ENDDO
     746                               - f_mg(k,j,i)                   )
    1012747                      ENDDO
    1013748                   ENDDO
    1014 
    1015                    !$OMP DO
    1016                    DO  i = nxl_mg(l)+1, nxr_mg(l), 2
    1017                       DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
    1018                          !DIR$ IVDEP
    1019                          DO  k = nzb+1, ind_even_odd
    1020                             km1 = k+ind_even_odd
    1021                             kp1 = k+ind_even_odd+1
    1022                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1023                                ddx2_mg(l) *                                    &
     749                ENDDO
     750   
     751                !$OMP DO
     752                DO  i = nxl_mg(l)+1, nxr_mg(l), 2
     753                   DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
     754                       !DIR$ IVDEP
     755                       DO  k = ind_even_odd+1, nzt_mg(l)
     756                         km1 = k-ind_even_odd-1
     757                         kp1 = k-ind_even_odd
     758                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     759                                 ddx2_mg(l) *                                  &
    1024760                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1025761                               + ddy2_mg(l) *                                  &
     
    1027763                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1028764                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1029                                - f_mg(k,j,i)               )
    1030                          ENDDO
     765                               - f_mg(k,j,i)                   )
    1031766                      ENDDO
    1032767                   ENDDO
    1033                    !$OMP END PARALLEL
    1034 
    1035                    CALL cpu_log( log_point_s(36), 'redblack_no_unroll_f', 'stop' )
    1036 
    1037                 ELSE
    1038 !
    1039 !--                Loop unrolling along y, only one i loop for better cache use
    1040                    CALL cpu_log( log_point_s(38), 'redblack_unroll_f', 'start' )
    1041 
    1042                    !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,km1,kp1,jj)
    1043                    !$OMP DO
    1044                    DO  ic = nxl_mg(l), nxr_mg(l), 2
    1045                       DO  jc = nys_mg(l), nyn_mg(l), 4
    1046                          i  = ic
    1047                          jj = jc+2-color
    1048                          !DIR$ IVDEP
    1049                          DO  k = ind_even_odd+1, nzt_mg(l)
    1050                             km1 = k-ind_even_odd-1
    1051                             kp1 = k-ind_even_odd
    1052                             j   = jj
    1053                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1054                                ddx2_mg(l) *                                    &
     768                ENDDO
     769 
     770                !$OMP DO
     771                DO  i = nxl_mg(l), nxr_mg(l), 2
     772                   DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
     773                      !DIR$ IVDEP
     774                      DO  k = nzb+1, ind_even_odd
     775                         km1 = k+ind_even_odd
     776                         kp1 = k+ind_even_odd+1
     777                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     778                                 ddx2_mg(l) *                                  &
    1055779                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1056780                               + ddy2_mg(l) *                                  &
     
    1058782                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1059783                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1060                                - f_mg(k,j,i)               )
    1061                             j = jj+2
    1062                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1063                                ddx2_mg(l) *                                    &
     784                               - f_mg(k,j,i)                   )
     785                      ENDDO
     786                   ENDDO
     787                ENDDO
     788
     789                !$OMP DO
     790                DO  i = nxl_mg(l)+1, nxr_mg(l), 2
     791                   DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
     792                      !DIR$ IVDEP
     793                      DO  k = nzb+1, ind_even_odd
     794                         km1 = k+ind_even_odd
     795                         kp1 = k+ind_even_odd+1
     796                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     797                                 ddx2_mg(l) *                                  &
    1064798                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1065799                               + ddy2_mg(l) *                                  &
     
    1067801                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1068802                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1069                                - f_mg(k,j,i)               )
    1070                          ENDDO
    1071 
    1072                          i  = ic+1
    1073                          jj = jc+color-1
    1074                          !DIR$ IVDEP
    1075                          DO  k = ind_even_odd+1, nzt_mg(l)
    1076                             km1 = k-ind_even_odd-1
    1077                             kp1 = k-ind_even_odd
    1078                             j   = jj
    1079                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1080                                ddx2_mg(l) *                                    &
    1081                                ( p_mg(k,j,i+1) + p_mg(k,j,i-1)  )              &
    1082                                + ddy2_mg(l) *                                  &
    1083                                ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    1084                                + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1085                                + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1086                                - f_mg(k,j,i)               )
    1087                             j = jj+2
    1088                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1089                                ddx2_mg(l) *                                    &
    1090                                ( p_mg(k,j,i+1) + p_mg(k,j,i-1)  )              &
    1091                                + ddy2_mg(l) *                                  &
    1092                                ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )              &
    1093                                + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1094                                + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1095                                - f_mg(k,j,i)               )
    1096                          ENDDO
    1097 
    1098                          i  = ic
    1099                          jj = jc+color-1
    1100                          !DIR$ IVDEP
    1101                          DO  k = nzb+1, ind_even_odd
    1102                             km1 = k+ind_even_odd
    1103                             kp1 = k+ind_even_odd+1
    1104                             j   = jj
    1105                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1106                                ddx2_mg(l) *                                    &
    1107                                ( p_mg(k,j,i+1) + p_mg(k,j,i-1)  )              &
    1108                                + ddy2_mg(l) *                                  &
    1109                                ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )              &
    1110                                + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1111                                + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1112                                - f_mg(k,j,i)               )
    1113                             j = jj+2
    1114                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1115                                ddx2_mg(l) *                                    &
     803                               - f_mg(k,j,i)                   )
     804                      ENDDO
     805                   ENDDO
     806                ENDDO
     807                !$OMP END PARALLEL
     808
     809                CALL cpu_log( log_point_s(36), 'redblack_no_unroll_f', 'stop' )
     810
     811             ELSE
     812!
     813!--              Loop unrolling along y, only one i loop for better cache use
     814                CALL cpu_log( log_point_s(38), 'redblack_unroll_f', 'start' )
     815
     816                !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,km1,kp1,jj)
     817                !$OMP DO
     818                DO  ic = nxl_mg(l), nxr_mg(l), 2
     819                   DO  jc = nys_mg(l), nyn_mg(l), 4
     820                      i  = ic
     821                      jj = jc+2-color
     822                      !DIR$ IVDEP
     823                      DO  k = ind_even_odd+1, nzt_mg(l)
     824                         km1 = k-ind_even_odd-1
     825                         kp1 = k-ind_even_odd
     826                         j   = jj
     827                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     828                                 ddx2_mg(l) *                                  &
    1116829                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1117830                               + ddy2_mg(l) *                                  &
     
    1119832                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1120833                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1121                                - f_mg(k,j,i)               )
    1122                          ENDDO
    1123 
    1124                          i  = ic+1
    1125                          jj = jc+2-color
    1126                          !DIR$ IVDEP
    1127                          DO  k = nzb+1, ind_even_odd
    1128                             km1 = k+ind_even_odd
    1129                             kp1 = k+ind_even_odd+1
    1130                             j   = jj
    1131                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1132                                ddx2_mg(l) *                                    &
    1133                                ( p_mg(k,j,i+1) + p_mg(k,j,i-1)  )              &
     834                               - f_mg(k,j,i)                   )
     835                         j = jj+2
     836                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     837                                 ddx2_mg(l) *                                  &
     838                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1134839                               + ddy2_mg(l) *                                  &
    1135840                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    1136841                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1137842                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1138                                - f_mg(k,j,i)               )
    1139                             j = jj+2
    1140                             p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (            &
    1141                                ddx2_mg(l) *                                    &
     843                               - f_mg(k,j,i)                   )
     844                      ENDDO
     845
     846                      i  = ic+1
     847                      jj = jc+color-1
     848                      !DIR$ IVDEP
     849                      DO  k = ind_even_odd+1, nzt_mg(l)
     850                         km1 = k-ind_even_odd-1
     851                         kp1 = k-ind_even_odd
     852                         j   = jj
     853                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     854                                 ddx2_mg(l) *                                  &
    1142855                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1143856                               + ddy2_mg(l) *                                  &
    1144                                ( p_mg(k,j+1,i) + p_mg(k,j-1,i)  )              &
     857                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
    1145858                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
    1146859                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
    1147                                - f_mg(k,j,i)               )
    1148                          ENDDO
    1149 
     860                               - f_mg(k,j,i)                   )
     861                         j = jj+2
     862                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     863                                 ddx2_mg(l) *                                  &
     864                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
     865                               + ddy2_mg(l) *                                  &
     866                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
     867                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
     868                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
     869                               - f_mg(k,j,i)                   )
    1150870                      ENDDO
    1151                    ENDDO
    1152                    !$OMP END PARALLEL
    1153 
    1154                    CALL cpu_log( log_point_s(38), 'redblack_unroll_f', 'stop' )
    1155 
    1156                 ENDIF
    1157 
    1158              ELSE
    1159 
    1160                 IF ( .NOT. unroll )  THEN
    1161 
    1162                    CALL cpu_log( log_point_s(36), 'redblack_no_unroll', 'start' )
    1163 !
    1164 !--                Without unrolling of loops, no cache optimization /
    1165 !--                vectorization. Therefore, the non-vectorized IBITS function
    1166 !--                is still used.
    1167                    !$OMP PARALLEL PRIVATE (i,j,k,km1,kp1)
    1168                    !$OMP DO
    1169                    DO  i = nxl_mg(l), nxr_mg(l), 2
    1170                       DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
    1171                          !DIR$ IVDEP
    1172                          DO  k = ind_even_odd+1, nzt_mg(l)
    1173                             km1 = k-ind_even_odd-1
    1174                             kp1 = k-ind_even_odd
    1175 
    1176                             p_mg(k,j,i) = 1.0_wp / f1_mg(k,l) * (              &
    1177                                ddx2_mg(l) *                                    &
    1178                                ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
    1179                                ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +               &
    1180                                p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *   &
    1181                                ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )               &
     871
     872                      i  = ic
     873                      jj = jc+color-1
     874                      !DIR$ IVDEP
     875                      DO  k = nzb+1, ind_even_odd
     876                         km1 = k+ind_even_odd
     877                         kp1 = k+ind_even_odd+1
     878                         j   = jj
     879                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     880                                 ddx2_mg(l) *                                  &
     881                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1182882                               + ddy2_mg(l) *                                  &
    1183                                ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
    1184                                ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +               &
    1185                                p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *   &
    1186                                ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )               &
    1187                                + f2_mg(k,l) * p_mg(kp1,j,i)                    &
    1188                                + f3_mg(k,l) *                                  &
    1189                                ( p_mg(km1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
    1190                                ( p_mg(k,j,i) - p_mg(km1,j,i) ) )               &
    1191                                - f_mg(k,j,i)               )
    1192                          ENDDO
     883                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
     884                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
     885                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
     886                               - f_mg(k,j,i)                   )
     887                         j = jj+2
     888                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     889                                 ddx2_mg(l) *                                  &
     890                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
     891                               + ddy2_mg(l) *                                  &
     892                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
     893                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
     894                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
     895                               - f_mg(k,j,i)                   )
    1193896                      ENDDO
    1194                    ENDDO
    1195    
    1196                    !$OMP DO
    1197                    DO  i = nxl_mg(l)+1, nxr_mg(l), 2
    1198                       DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
    1199                           !DIR$ IVDEP
    1200                           DO  k = ind_even_odd+1, nzt_mg(l)
    1201                             km1 = k-ind_even_odd-1
    1202                             kp1 = k-ind_even_odd
    1203 
    1204                             p_mg(k,j,i) = 1.0_wp / f1_mg(k,l) * (              &
    1205                                ddx2_mg(l) *                                    &
    1206                                ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
    1207                                ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +               &
    1208                                p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *   &
    1209                                ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )               &
     897
     898                      i  = ic+1
     899                      jj = jc+2-color
     900                      !DIR$ IVDEP
     901                      DO  k = nzb+1, ind_even_odd
     902                         km1 = k+ind_even_odd
     903                         kp1 = k+ind_even_odd+1
     904                         j   = jj
     905                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     906                                 ddx2_mg(l) *                                  &
     907                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
    1210908                               + ddy2_mg(l) *                                  &
    1211                                ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
    1212                                ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +               &
    1213                                p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *   &
    1214                                ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )               &
    1215                                + f2_mg(k,l) * p_mg(kp1,j,i)                    &
    1216                                + f3_mg(k,l) *                                  &
    1217                                ( p_mg(km1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
    1218                                ( p_mg(k,j,i) - p_mg(km1,j,i) ) )               &
    1219                                - f_mg(k,j,i)               )
    1220                          ENDDO
     909                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
     910                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
     911                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
     912                               - f_mg(k,j,i)                   )
     913                         j = jj+2
     914                         p_mg(k,j,i) = 1.0_wp / f1_mg_b(k,l) * (               &
     915                                 ddx2_mg(l) *                                  &
     916                               ( p_mg(k,j,i+1) + p_mg(k,j,i-1) )               &
     917                               + ddy2_mg(l) *                                  &
     918                               ( p_mg(k,j+1,i) + p_mg(k,j-1,i) )               &
     919                               + f2_mg_b(k,l) * p_mg(kp1,j,i)                  &
     920                               + f3_mg_b(k,l) * p_mg(km1,j,i)                  &
     921                               - f_mg(k,j,i)                   )
    1221922                      ENDDO
    1222                    ENDDO
    1223 
    1224                    !$OMP DO
    1225                    DO  i = nxl_mg(l), nxr_mg(l), 2
    1226                       DO  j = nys_mg(l) + (color-1), nyn_mg(l), 2
    1227                          !DIR$ IVDEP
    1228                          DO  k = nzb+1, ind_even_odd
    1229                             km1 = k+ind_even_odd
    1230                             kp1 = k+ind_even_odd+1
    1231                             p_mg(k,j,i) = 1.0_wp / f1_mg(k,l) * (              &
    1232                                ddx2_mg(l) *                                    &
    1233                                ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
    1234                                ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +               &
    1235                                p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *   &
    1236                                ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )               &
    1237                                + ddy2_mg(l) *                                  &
    1238                                ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
    1239                                ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +               &
    1240                                p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *   &
    1241                                ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )               &
    1242                                + f2_mg(k,l) * p_mg(kp1,j,i)                    &
    1243                                + f3_mg(k,l) *                                  &
    1244                                ( p_mg(km1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
    1245                                ( p_mg(k,j,i) - p_mg(km1,j,i) ) ) &
    1246                                - f_mg(k,j,i)               )
    1247                          ENDDO
    1248                       ENDDO
    1249                    ENDDO
    1250 
    1251                    !$OMP DO
    1252                    DO  i = nxl_mg(l)+1, nxr_mg(l), 2
    1253                       DO  j = nys_mg(l) + 2 - color, nyn_mg(l), 2
    1254                          !DIR$ IVDEP
    1255                          DO  k = nzb+1, ind_even_odd
    1256                             km1 = k+ind_even_odd
    1257                             kp1 = k+ind_even_odd+1
    1258 
    1259                             p_mg(k,j,i) = 1.0_wp / f1_mg(k,l) * (              &
    1260                                ddx2_mg(l) *                                    &
    1261                                ( p_mg(k,j,i+1) + IBITS( flags(k,j,i), 5, 1 ) * &
    1262                                ( p_mg(k,j,i) - p_mg(k,j,i+1) ) +               &
    1263                                p_mg(k,j,i-1) + IBITS( flags(k,j,i), 4, 1 ) *   &
    1264                                ( p_mg(k,j,i) - p_mg(k,j,i-1) ) )               &
    1265                                + ddy2_mg(l) *                                  &
    1266                                ( p_mg(k,j+1,i) + IBITS( flags(k,j,i), 3, 1 ) * &
    1267                                ( p_mg(k,j,i) - p_mg(k,j+1,i) ) +               &
    1268                                p_mg(k,j-1,i) + IBITS( flags(k,j,i), 2, 1 ) *   &
    1269                                ( p_mg(k,j,i) - p_mg(k,j-1,i) ) )               &
    1270                                + f2_mg(k,l) * p_mg(kp1,j,i)                    &
    1271                                + f3_mg(k,l) *                                  &
    1272                                ( p_mg(km1,j,i) + IBITS( flags(k,j,i), 0, 1 ) * &
    1273                                ( p_mg(k,j,i) - p_mg(km1,j,i) ) )               &
    1274                                - f_mg(k,j,i)               )
    1275                          ENDDO
    1276                       ENDDO
    1277                    ENDDO
    1278                    !$OMP END PARALLEL
    1279 
    1280                    CALL cpu_log( log_point_s(36), 'redblack_no_unroll', 'stop' )
    1281 
    1282                 ELSE
    1283 !
    1284 !--                Loop unrolling along y, only one i loop for better cache use
    1285                    CALL cpu_log( log_point_s(38), 'redblack_unroll', 'start' )
    1286 
    1287                    !$OMP PARALLEL PRIVATE (i,j,k,ic,jc,km1,kp1,jj)
    1288                    !$OMP DO
    1289                    DO  ic = nxl_mg(l), nxr_mg(l), 2
    1290                       DO  jc = nys_mg(l), nyn_mg(l), 4
    1291                          i  = ic
    1292                          jj = jc+2-color
    1293                          !DIR$ IVDEP
    1294                          DO  k = ind_even_odd+1, nzt_mg(l)
    1295 
    1296                             km1 = k-ind_even_odd-1
    1297                             kp1 = k-ind_even_odd
    1298 
    1299                             j = jj
    1300                             p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                               &
    1301                                 ddx2_mg(l) *                                                 &
    1302                                 ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5))   &
    1303                                 + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4)) ) &
    1304                                 + ddy2_mg(l) *                                               &
    1305                                 ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3))   &
    1306                                 + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2)) ) &
    1307                                 + f2_mg(k,l) * p_mg(kp1,j,i)                                 &
    1308                                 + f3_mg(k,l) *                                               &
    1309                                 MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0))     &
    1310                                 - f_mg(k,j,i)               )
    1311                             j = jj+2
    1312                             p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                               &
    1313                                 ddx2_mg(l) *                                                 &
    1314                                 ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5))   &
    1315                                 + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4)) ) &
    1316                                 + ddy2_mg(l) *                                               &
    1317                                 ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3))   &
    1318                                 + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2)) ) &
    1319                                 + f2_mg(k,l) * p_mg(kp1,j,i)                                 &
    1320                                 + f3_mg(k,l) *                                               &
    1321                                 MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0))     &
    1322                                 - f_mg(k,j,i)               )
    1323 
    1324                          ENDDO
    1325 
    1326                          i  = ic+1
    1327                          jj = jc+color-1
    1328                          !DIR$ IVDEP
    1329                          DO  k = ind_even_odd+1, nzt_mg(l)
    1330 
    1331                             km1 = k-ind_even_odd-1
    1332                             kp1 = k-ind_even_odd
    1333 
    1334                             j =jj
    1335                             p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                               &
    1336                                 ddx2_mg(l) *                                                 &
    1337                                 ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5))   &
    1338                                 + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4)) ) &
    1339                                 + ddy2_mg(l) *                                               &
    1340                                 ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3))   &
    1341                                 + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2)) ) &
    1342                                 + f2_mg(k,l) * p_mg(kp1,j,i)                                 &
    1343                                 + f3_mg(k,l) *                                               &
    1344                                 MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0))     &
    1345                                 - f_mg(k,j,i)               )
    1346 
    1347                             j = jj+2
    1348                             p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                               &
    1349                                 ddx2_mg(l) *                                                 &
    1350                                 ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5))   &
    1351                                 + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4)) ) &
    1352                                 + ddy2_mg(l) *                                               &
    1353                                 ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3))   &
    1354                                 + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2)) ) &
    1355                                 + f2_mg(k,l) * p_mg(kp1,j,i)                                 &
    1356                                 + f3_mg(k,l) *                                               &
    1357                                 MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0))     &
    1358                                 - f_mg(k,j,i)               )
    1359 
    1360                          ENDDO
    1361 
    1362                          i  = ic
    1363                          jj = jc+color-1
    1364                          !DIR$ IVDEP
    1365                          DO  k = nzb+1, ind_even_odd
    1366 
    1367                             km1 = k+ind_even_odd
    1368                             kp1 = k+ind_even_odd+1
    1369 
    1370                             j =jj
    1371                             p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                               &
    1372                                 ddx2_mg(l) *                                                 &
    1373                                 ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5))   &
    1374                                 + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4)) ) &
    1375                                 + ddy2_mg(l) *                                               &
    1376                                 ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3))   &
    1377                                 + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2)) ) &
    1378                                 + f2_mg(k,l) * p_mg(kp1,j,i)                                 &
    1379                                 + f3_mg(k,l) *                                               &
    1380                                 MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0))     &
    1381                                 - f_mg(k,j,i)               )
    1382 
    1383                             j = jj+2
    1384                             p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                               &
    1385                                 ddx2_mg(l) *                                                 &
    1386                                 ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5))   &
    1387                                 + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4)) ) &
    1388                                 + ddy2_mg(l) *                                               &
    1389                                 ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3))   &
    1390                                 + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2)) ) &
    1391                                 + f2_mg(k,l) * p_mg(kp1,j,i)                                 &
    1392                                 + f3_mg(k,l) *                                               &
    1393                                 MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0))     &
    1394                                 - f_mg(k,j,i)               )
    1395 
    1396                          ENDDO
    1397 
    1398                          i  = ic+1
    1399                          jj = jc+2-color
    1400                          !DIR$ IVDEP
    1401                          DO  k = nzb+1, ind_even_odd
    1402 
    1403                             km1 = k+ind_even_odd
    1404                             kp1 = k+ind_even_odd+1
    1405 
    1406                             j =jj
    1407                             p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                               &
    1408                                 ddx2_mg(l) *                                                 &
    1409                                 ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5))   &
    1410                                 + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4)) ) &
    1411                                 + ddy2_mg(l) *                                               &
    1412                                 ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3))   &
    1413                                 + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2)) ) &
    1414                                 + f2_mg(k,l) * p_mg(kp1,j,i)                                 &
    1415                                 + f3_mg(k,l) *                                               &
    1416                                 MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0))     &
    1417                                 - f_mg(k,j,i)               )
    1418 
    1419                             j = jj+2
    1420                             p_mg(k,j,i) = 1.0 / f1_mg(k,l) * (                               &
    1421                                 ddx2_mg(l) *                                                 &
    1422                                 ( MERGE(p_mg(k,j,i),p_mg(k,j,i+1),BTEST( flags(k,j,i), 5))   &
    1423                                 + MERGE(p_mg(k,j,i),p_mg(k,j,i-1),BTEST( flags(k,j,i), 4)) ) &
    1424                                 + ddy2_mg(l) *                                               &
    1425                                 ( MERGE(p_mg(k,j,i),p_mg(k,j+1,i),BTEST( flags(k,j,i), 3))   &
    1426                                 + MERGE(p_mg(k,j,i),p_mg(k,j-1,i),BTEST( flags(k,j,i), 2)) ) &
    1427                                 + f2_mg(k,l) * p_mg(kp1,j,i)                                 &
    1428                                 + f3_mg(k,l) *                                               &
    1429                                 MERGE(p_mg(k,j,i),p_mg(km1,j,i),BTEST( flags(k,j,i), 0))     &
    1430                                 - f_mg(k,j,i)               )
    1431 
    1432                          ENDDO
    1433 
    1434                       ENDDO
    1435                    ENDDO
    1436                    !$OMP END PARALLEL
    1437 
    1438                    CALL cpu_log( log_point_s(38), 'redblack_unroll', 'stop' )
    1439 
    1440                 ENDIF
     923
     924                   ENDDO
     925                ENDDO
     926                !$OMP END PARALLEL
     927
     928                CALL cpu_log( log_point_s(38), 'redblack_unroll_f', 'stop' )
    1441929
    1442930             ENDIF
     
    1467955!--          Bottom and top boundary conditions
    1468956             IF ( ibc_p_b == 1 )  THEN
     957!
     958!--             equivalent to p_mg(nzb,:,: ) = p_mg(nzb+1,:,:)
    1469959                p_mg(nzb,:,: ) = p_mg(ind_even_odd+1,:,:)
    1470960             ELSE
     
    1473963
    1474964             IF ( ibc_p_t == 1 )  THEN
     965!
     966!--             equivalent to p_mg(nzt_mg(l)+1,:,: ) = p_mg(nzt_mg(l),:,:)
    1475967                p_mg(nzt_mg(l)+1,:,: ) = p_mg(ind_even_odd,:,:)
    1476968             ELSE
     
    1479971
    1480972          ENDDO
     973
    1481974       ENDDO
    1482 !
    1483 !--    Set pressure within topography and at the topography surfaces
    1484        IF ( topography /= 'flat'  .AND.  .NOT. masking_method )  THEN
    1485 
    1486           !$OMP PARALLEL PRIVATE (i,j,k,kp1,wall_left,wall_north,wall_right,   &
    1487           !$OMP                   wall_south,wall_top,wall_total)
    1488           !$OMP DO
    1489           DO  i = nxl_mg(l), nxr_mg(l)
    1490              DO  j = nys_mg(l), nyn_mg(l)
    1491                 !DIR$ IVDEP
    1492                 DO  k = ind_even_odd+1, nzt_mg(l)
    1493                    km1 = k-ind_even_odd-1
    1494                    kp1 = k-ind_even_odd
    1495 !
    1496 !--                First, set pressure inside topography to zero
    1497                    p_mg(k,j,i) = p_mg(k,j,i) *                                 &
    1498                                  ( 1.0_wp - IBITS( flags(k,j,i), 6, 1 ) )
    1499 !
    1500 !--                Second, determine if the gridpoint inside topography is
    1501 !--                adjacent to a wall and set its value to a value given by the
    1502 !--                average of those values obtained from Neumann boundary
    1503 !--                condition
    1504                    wall_left  = IBITS( flags(k,j,i-1), 5, 1 )
    1505                    wall_right = IBITS( flags(k,j,i+1), 4, 1 )
    1506                    wall_south = IBITS( flags(k,j-1,i), 3, 1 )
    1507                    wall_north = IBITS( flags(k,j+1,i), 2, 1 )
    1508                    wall_top   = IBITS( flags(kp1,j,i), 0, 1 )
    1509                    wall_total = wall_left + wall_right + wall_south +          &
    1510                                 wall_north + wall_top
    1511 
    1512                    IF ( wall_total > 0.0_wp )  THEN
    1513                       p_mg(k,j,i) = 1.0_wp / wall_total *                      &
    1514                                     ( wall_left  * p_mg(k,j,i-1) +             &
    1515                                       wall_right * p_mg(k,j,i+1) +             &
    1516                                       wall_south * p_mg(k,j-1,i) +             &
    1517                                       wall_north * p_mg(k,j+1,i) +             &
    1518                                       wall_top   * p_mg(kp1,j,i) )
    1519                    ENDIF
    1520                 ENDDO
    1521 
    1522                 !DIR$ IVDEP
    1523                 DO  k = nzb+1, ind_even_odd
    1524                    km1 = k+ind_even_odd
    1525                    kp1 = k+ind_even_odd+1
    1526 !
    1527 !--                First, set pressure inside topography to zero
    1528                    p_mg(k,j,i) = p_mg(k,j,i) *                                 &
    1529                                  ( 1.0_wp - IBITS( flags(k,j,i), 6, 1 ) )
    1530 !
    1531 !--                Second, determine if the gridpoint inside topography is
    1532 !--                adjacent to a wall and set its value to a value given by the
    1533 !--                average of those values obtained from Neumann boundary
    1534 !--                condition
    1535                    wall_left  = IBITS( flags(k,j,i-1), 5, 1 )
    1536                    wall_right = IBITS( flags(k,j,i+1), 4, 1 )
    1537                    wall_south = IBITS( flags(k,j-1,i), 3, 1 )
    1538                    wall_north = IBITS( flags(k,j+1,i), 2, 1 )
    1539                    wall_top   = IBITS( flags(kp1,j,i), 0, 1 )
    1540                    wall_total = wall_left + wall_right + wall_south +          &
    1541                                 wall_north + wall_top
    1542 
    1543                    IF ( wall_total > 0.0_wp )  THEN
    1544                       p_mg(k,j,i) = 1.0_wp / wall_total *                      &
    1545                                     ( wall_left  * p_mg(k,j,i-1) +             &
    1546                                       wall_right * p_mg(k,j,i+1) +             &
    1547                                       wall_south * p_mg(k,j-1,i) +             &
    1548                                       wall_north * p_mg(k,j+1,i) +             &
    1549                                       wall_top   * p_mg(kp1,j,i) )
    1550                    ENDIF
    1551                 ENDDO
    1552              ENDDO
    1553           ENDDO
    1554           !$OMP END PARALLEL
    1555 
    1556 !
    1557 !--       One more time horizontal boundary conditions
    1558           CALL exchange_horiz( p_mg, 1)
    1559 
    1560        ENDIF
    1561975
    1562976    END SUBROUTINE redblack_fast
     
    1581995       IMPLICIT NONE
    1582996
    1583        INTEGER(iwp), INTENT(IN) ::  glevel
     997       INTEGER(iwp), INTENT(IN) ::  glevel  !< grid level
    1584998
    1585999       REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1,                               &
    15861000                           nys_mg(glevel)-1:nyn_mg(glevel)+1,                  &
    1587                            nxl_mg(glevel)-1:nxr_mg(glevel)+1) ::  p_mg  !<
     1001                           nxl_mg(glevel)-1:nxr_mg(glevel)+1) ::               &
     1002                                      p_mg  !< array to be sorted
    15881003!
    15891004!--    Local variables
    1590        INTEGER(iwp) :: i        !<
    1591        INTEGER(iwp) :: j        !<
    1592        INTEGER(iwp) :: k        !<
    1593        INTEGER(iwp) :: l        !<
    1594        INTEGER(iwp) :: ind      !<
    1595        REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1) ::  tmp  !<
     1005       INTEGER(iwp) :: i        !< index variable along x
     1006       INTEGER(iwp) :: j        !< index variable along y
     1007       INTEGER(iwp) :: k        !< index variable along z
     1008       INTEGER(iwp) :: l        !< grid level
     1009       INTEGER(iwp) :: ind      !< index variable along z
     1010       REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1) ::  tmp  !< odd-even sorted temporary array
    15961011
    15971012
     
    16461061       IMPLICIT NONE
    16471062
    1648        INTEGER(iwp), INTENT(IN) ::  glevel
    1649 
    1650        REAL(wp), DIMENSION(nzb+1:nzt_mg(glevel)) ::  f_mg
    1651        REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1) ::  f_mg_b
     1063       INTEGER(iwp), INTENT(IN) ::  glevel  !< grid level
     1064
     1065       REAL(wp), DIMENSION(nzb+1:nzt_mg(glevel)) ::  f_mg    !< 1D input array
     1066       REAL(wp), DIMENSION(nzb:nzt_mg(glevel)+1) ::  f_mg_b  !< 1D output array
    16521067
    16531068!
    16541069!--    Local variables
    1655        INTEGER(iwp) :: ind   !<
    1656        INTEGER(iwp) :: k     !<
     1070       INTEGER(iwp) :: ind   !< index variable along z
     1071       INTEGER(iwp) :: k     !< index variable along z
    16571072
    16581073
     
    16961111       IMPLICIT NONE
    16971112
    1698        INTEGER(iwp), INTENT(IN) ::  glevel
     1113       INTEGER(iwp), INTENT(IN) ::  glevel  !< grid level
    16991114
    17001115       INTEGER(iwp), DIMENSION(nzb:nzt_mg(glevel)+1,                           &
    17011116                               nys_mg(glevel)-1:nyn_mg(glevel)+1,              &
    1702                                nxl_mg(glevel)-1:nxr_mg(glevel)+1) ::  i_mg  !<
     1117                               nxl_mg(glevel)-1:nxr_mg(glevel)+1) ::           &
     1118                                    i_mg    !< array to be sorted
    17031119!
    17041120!--    Local variables
    1705        INTEGER(iwp) :: i        !<
    1706        INTEGER(iwp) :: j        !<
    1707        INTEGER(iwp) :: k        !<
    1708        INTEGER(iwp) :: l        !<
    1709        INTEGER(iwp) :: ind      !<
    1710        INTEGER(iwp),DIMENSION(nzb:nzt_mg(glevel)+1) ::  tmp
     1121       INTEGER(iwp) :: i        !< index variabel along x
     1122       INTEGER(iwp) :: j        !< index variable along y
     1123       INTEGER(iwp) :: k        !< index variable along z
     1124       INTEGER(iwp) :: l        !< grid level
     1125       INTEGER(iwp) :: ind      !< index variable along z
     1126       INTEGER(iwp),DIMENSION(nzb:nzt_mg(glevel)+1) ::  tmp  !< temporary odd-even sorted array
    17111127
    17121128
     
    17701186       REAL(wp), DIMENSION(nzb:nzt_mg(grid_level)+1,                           &
    17711187                           nys_mg(grid_level)-1:nyn_mg(grid_level)+1,          &
    1772                            nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::  p_mg  !<
     1188                           nxl_mg(grid_level)-1:nxr_mg(grid_level)+1) ::       &
     1189                                     p_mg  !< array to be sorted
    17731190!
    17741191!--    Local variables
    1775        INTEGER(iwp) :: i        !<
    1776        INTEGER(iwp) :: j        !<
    1777        INTEGER(iwp) :: k        !<
    1778        INTEGER(iwp) :: l        !<
    1779        INTEGER(iwp) :: ind      !<
     1192       INTEGER(iwp) :: i        !< index variable along x
     1193       INTEGER(iwp) :: j        !< index variable along y
     1194       INTEGER(iwp) :: k        !< index variable along z
     1195       INTEGER(iwp) :: l        !< grid level
     1196       INTEGER(iwp) :: ind      !< index variable along z
    17801197
    17811198       REAL(wp),DIMENSION(nzb:nzt_mg(grid_level)+1) ::  tmp
     
    19581375       IMPLICIT NONE
    19591376
    1960        INTEGER(iwp) ::  i            !<
    1961        INTEGER(iwp) ::  j            !<
    1962        INTEGER(iwp) ::  k            !<
     1377       INTEGER(iwp) ::  i            !< index variable along x
     1378       INTEGER(iwp) ::  j            !< index variable along y
     1379       INTEGER(iwp) ::  k            !< index variable along z
    19631380       INTEGER(iwp) ::  nxl_mg_save  !<
    19641381       INTEGER(iwp) ::  nxr_mg_save  !<
     
    23081725
    23091726       USE control_parameters,                                                 &
    2310            ONLY:  grid_level, masking_method, maximum_grid_level, topography
     1727           ONLY:  grid_level, maximum_grid_level
    23111728
    23121729       USE indices,                                                            &
     
    23141731
    23151732       USE indices,                                                            &
    2316            ONLY:  flags, wall_flags_1, wall_flags_2, wall_flags_3,             &
    2317                   wall_flags_4, wall_flags_5, wall_flags_6, wall_flags_7,      &
    2318                   wall_flags_8, wall_flags_9, wall_flags_10, nxl_mg, nxr_mg,   &
    2319                   nys_mg, nyn_mg, nzb, nzt_mg
     1733           ONLY:  nxl_mg, nxr_mg, nys_mg, nyn_mg, nzb, nzt_mg
    23201734
    23211735       IMPLICIT NONE
    23221736!
    23231737!--    Local variables
    2324        INTEGER(iwp) ::  i     !<
     1738       INTEGER(iwp) ::  i     !< 
    23251739       INTEGER(iwp) ::  l     !<
    23261740
     
    23571771       ENDDO
    23581772
    2359 !
    2360 !--    Sort flags array for all levels to block (even/odd) structure
    2361        IF ( topography /= 'flat'  .AND.  .NOT. masking_method )  THEN
    2362 
    2363           DO  l = maximum_grid_level, 1 , -1
    2364 !
    2365 !--          Assign the flag level to be calculated
    2366              SELECT CASE ( l )
    2367                 CASE ( 1 )
    2368                    flags => wall_flags_1
    2369                 CASE ( 2 )
    2370                    flags => wall_flags_2
    2371                 CASE ( 3 )
    2372                    flags => wall_flags_3
    2373                 CASE ( 4 )
    2374                    flags => wall_flags_4
    2375                 CASE ( 5 )
    2376                    flags => wall_flags_5
    2377                 CASE ( 6 )
    2378                    flags => wall_flags_6
    2379                 CASE ( 7 )
    2380                    flags => wall_flags_7
    2381                 CASE ( 8 )
    2382                    flags => wall_flags_8
    2383                 CASE ( 9 )
    2384                    flags => wall_flags_9
    2385                 CASE ( 10 )
    2386                    flags => wall_flags_10
    2387              END SELECT
    2388 
    2389              CALL sort_k_to_even_odd_blocks( flags, l )
    2390 
    2391           ENDDO
    2392 
    2393        ENDIF
    2394 
    23951773       lfirst = .FALSE.
    23961774
Note: See TracChangeset for help on using the changeset viewer.