Index: palm/trunk/SOURCE/coriolis.f90
===================================================================
--- palm/trunk/SOURCE/coriolis.f90	(revision 2233)
+++ palm/trunk/SOURCE/coriolis.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file coriolis.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Forcing implemented, preliminary (MS)
+! 
+! 2233 2017-05-30 18:08:54Z suehring
 !
 ! 2232 2017-05-30 17:47:52Z suehring
@@ -102,5 +105,5 @@
            
        USE control_parameters,                                                 &
-           ONLY:  f, fs, message_string
+           ONLY:  f, forcing, fs, message_string
            
        USE indices,                                                            &
@@ -117,4 +120,7 @@
 
        REAL(wp)     ::  flag       !< flag to mask topography
+       REAL(wp)     ::  flag_force !< flag to mask large-scale pressure gradient in case larger-scale forcing is applied
+
+       flag_force = MERGE( 0.0_wp, 1.0_wp, forcing )
 !
 !--    Compute Coriolis terms for the three velocity components
@@ -128,5 +134,5 @@
                    DO  k = nzb+1, nzt
 !
-!--                    Predetermine flag to mask topography
+!--                   Predetermine flag to mask topography
                       flag = MERGE( 1.0_wp, 0.0_wp,                            &
                                     BTEST( wall_flags_0(k,j,i), 1 ) )
@@ -134,9 +140,10 @@
                       tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *          &
                                    ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +    &
-                                     v(k,j+1,i) ) - vg(k)   ) * flag           &
+                                     v(k,j+1,i) ) - vg(k) * flag_force         &
+                                                          ) * flag           &
                                                 - fs *    ( 0.25_wp *          &
                                    ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +  &
                                      w(k,j,i)   )                              &
-                                                          )   * flag
+                                                          ) * flag
                    ENDDO
                 ENDDO
@@ -149,9 +156,13 @@
                 DO  j = nysv, nyn
                    DO  k = nzb+1, nzt
+!
+!--                   Predetermine flag to mask topography
+                      flag = MERGE( 1.0_wp, 0.0_wp,                            &
+                                    BTEST( wall_flags_0(k,j,i), 2 ) )
+
                       tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *          &
                                    ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +    &
-                                     u(k,j,i+1) ) - ug(k) ) *                  &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 2 ) )
+                                     u(k,j,i+1) ) - ug(k) * flag_force         &
+                                                          ) * flag
                    ENDDO
                 ENDDO
@@ -164,9 +175,12 @@
                 DO  j = nys, nyn
                    DO  k = nzb+1, nzt
+!
+!--                   Predetermine flag to mask topography
+                      flag = MERGE( 1.0_wp, 0.0_wp,                            &
+                                    BTEST( wall_flags_0(k,j,i), 3 ) )
+
                       tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *               &
                                    ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +      &
-                                     u(k+1,j,i+1) ) *                          &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 3 ) )
+                                     u(k+1,j,i+1) ) * flag
                    ENDDO
                 ENDDO
@@ -194,5 +208,5 @@
            
        USE control_parameters,                                                 &
-           ONLY:  f, fs, message_string
+           ONLY:  f, forcing, fs, message_string
            
        USE indices,                                                            &
@@ -209,5 +223,7 @@
 
        REAL(wp)     ::  flag       !< flag to mask topography
-
+       REAL(wp)     ::  flag_force !< flag to mask large-scale pressure gradient in case larger-scale forcing is applied
+
+       flag_force = MERGE( 0.0_wp, 1.0_wp, forcing )
 !
 !--    Compute Coriolis terms for the three velocity components
@@ -224,8 +240,9 @@
                 tend(k,j,i) = tend(k,j,i) + f  *     ( 0.25_wp *               &
                                 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +       &
-                                  v(k,j+1,i) ) - vg(k) ) * flag                &
-                                          - fs *    ( 0.25_wp *                &
+                                  v(k,j+1,i) ) - vg(k) * flag_force            &
+                                                     ) * flag                  &
+                                          - fs *     ( 0.25_wp *               &
                                 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +     &
-                                  w(k,j,i)   )      ) * flag
+                                  w(k,j,i)   )       ) * flag
              ENDDO
 
@@ -234,9 +251,12 @@
           CASE ( 2 )
              DO  k = nzb+1, nzt
+!
+!--             Predetermine flag to mask topography
+                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 2 ) )
+
                 tend(k,j,i) = tend(k,j,i) - f *        ( 0.25_wp *             &
                                 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +       &
-                                  u(k,j,i+1) ) - ug(k) ) *                     &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 2 ) )
+                                  u(k,j,i+1) ) - ug(k)   * flag_force          &
+                                                       ) * flag
              ENDDO
 
@@ -245,9 +265,11 @@
           CASE ( 3 )
              DO  k = nzb+1, nzt
+!
+!--             Predetermine flag to mask topography
+                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 3 ) )
+
                 tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *                     &
                                 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +         &
-                                  u(k+1,j,i+1) ) *                             &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 3 ) )
+                                  u(k+1,j,i+1) ) * flag
              ENDDO
 
