Index: palm/trunk/SOURCE/coriolis.f90
===================================================================
--- palm/trunk/SOURCE/coriolis.f90	(revision 4901)
+++ palm/trunk/SOURCE/coriolis.f90	(revision 1)
@@ -1,44 +1,48 @@
-!> @file coriolis.f90
-!--------------------------------------------------------------------------------------------------!
-! This file is part of the PALM model system.
-!
-! PALM is free software: you can redistribute it and/or modify it under the terms of the GNU General
-! Public License as published by the Free Software Foundation, either version 3 of the License, or
-! (at your option) any later version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the
-! implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General
-! Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with PALM. If not, see
-! <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2021 Leibniz Universitaet Hannover
-!--------------------------------------------------------------------------------------------------!
-!
-! Current revisions:
+ MODULE coriolis_mod
+
+!------------------------------------------------------------------------------!
+! Actual revisions:
 ! -----------------
 ! 
-! 
+!
 ! Former revisions:
 ! -----------------
-! $Id$
-! file re-formatted to follow the PALM coding standard
-!
-! 4360 2020-01-07 11:25:50Z suehring
-! Introduction of wall_flags_total_0, which currently sets bits based on static topography
-! information used in wall_flags_static_0
-!
-! 4329 2019-12-10 15:46:36Z motisi
-! Renamed wall_flags_0 to wall_flags_static_0
-!
-! 4196 2019-08-29 11:02:06Z gronemeier
-! Consider rotation of model domain
-!
-! 4182 2019-08-22 15:20:23Z scharf
-! Corrected "Former revisions" section
-!
-! 3655 2019-01-07 16:51:22Z knoop
-! OpenACC port for SPEC
+! $Log: coriolis.f90,v $
+! Revision 1.12  2006/02/23 10:08:57  raasch
+! nzb_2d replaced by nzb_u/v/w_inner
+!
+! Revision 1.11  2005/06/29 10:30:17  steinfeld
+! A potential dependency of the geostrophic wind components ug and vg on height
+! is considered
+!
+! Revision 1.10  2005/03/26 20:02:04  raasch
+! Extension of horizontal loop upper bounds for non-cyclic boundary conditions
+!
+! Revision 1.9  2004/01/30 10:17:34  raasch
+! Scalar lower k index nzb replaced by 2d-array nzb_2d
+!
+! Revision 1.8  2003/03/12 16:23:47  raasch
+! Full code replaced in the call for all gridpoints instead of calling the
+! _ij version (required by NEC, because otherwise no vectorization)
+!
+! Revision 1.7  2002/12/19 14:08:14  raasch
+! STOP statement replaced by call of subroutine local_stop
+!
+! Revision 1.6  2002/06/11 12:51:09  raasch
+! Former subroutine changed to a module which allows to be called for all grid
+! points of a single vertical column with index i,j or for all grid points by
+! using function overloading.
+!
+! Revision 1.5  2001/03/30 06:59:09  raasch
+! Translation of remaining German identifiers (variables, subroutines, etc.)
+!
+! Revision 1.4  2001/01/22 05:44:16  raasch
+! Module test_variables removed
+!
+! Revision 1.3  2000/12/20 09:50:27  letzel
+! All comments translated into English.
+!
+! Revision 1.2  1998/07/06 12:09:54  raasch
+! + USE test_variables
 !
 ! Revision 1.1  1997/08/29 08:57:38  raasch
@@ -48,12 +52,6 @@
 ! Description:
 ! ------------
-!> Computation of all Coriolis terms in the equations of motion.
-!>
-!> @note In this routine the topography is masked, even though this is again done in
-!> prognostic_equations. However, omitting the masking here lead to slightly different results.
-!> Reason unknown.
-!--------------------------------------------------------------------------------------------------!
- MODULE coriolis_mod
-
+! Computation of all Coriolis terms in the equations of motion.
+!------------------------------------------------------------------------------!
 
     PRIVATE
@@ -68,40 +66,18 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!--------------------------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
+! Call for all grid points
+!------------------------------------------------------------------------------!
     SUBROUTINE coriolis( component )
 
-       USE arrays_3d,                                                                              &
-           ONLY:  tend, u, ug, v, vg, w
-
-       USE basic_constants_and_equations_mod,                                                      &
-           ONLY:  pi
-
-       USE control_parameters,                                                                     &
-           ONLY:  f, fs, message_string, rotation_angle
-
-       USE indices,                                                                                &
-           ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb, nzt, wall_flags_total_0
-
-       USE kinds
+       USE arrays_3d
+       USE control_parameters
+       USE indices
+       USE pegrid
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  component      !< component of momentum equation
-       INTEGER(iwp) ::  i              !< running index x direction
-       INTEGER(iwp) ::  j              !< running index y direction
-       INTEGER(iwp) ::  k              !< running index z direction
-
-       REAL(wp)     ::  cos_rot_angle  !< cosine of model rotation angle
-       REAL(wp)     ::  flag           !< flag to mask topography
-       REAL(wp)     ::  sin_rot_angle  !< sine of model rotation angle
-
-!
-!--    Precalculate cosine and sine of rotation angle
-       cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-       sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
+       INTEGER ::  component, i, j, k
+
 
 !
@@ -112,22 +88,14 @@
 !--       u-component
           CASE ( 1 )
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
-             !$ACC PRESENT(wall_flags_total_0) &
-             !$ACC PRESENT(v, w, vg) &
-             !$ACC PRESENT(tend)
-             DO  i = nxlu, nxr
+             DO  i = nxl, nxr+uxrp
                 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_total_0(k,j,i), 1 ) )
-
-                      tend(k,j,i) = tend(k,j,i) + flag *                                           &
-                            ( 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) )                                                          &
-                            - fs * cos_rot_angle                                                   &
-                              * 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) )    &
-                            )
+                   DO  k = nzb_u_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *            &
+                                   ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +   &
+                                     v(k,j+1,i) ) - vg(k) )                   &
+                                             - fs *    ( 0.25 *               &
+                                   ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
+                                     w(k,j,i)   ) &
+                                                          )
                    ENDDO
                 ENDDO
@@ -137,22 +105,10 @@
 !--       v-component
           CASE ( 2 )
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
-             !$ACC PRESENT(wall_flags_total_0) &
-             !$ACC PRESENT(u, w, ug) &
-             !$ACC PRESENT(tend)
              DO  i = nxl, nxr
-                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_total_0(k,j,i), 2 ) )
-
-                      tend(k,j,i) = tend(k,j,i) - flag *                                           &
-                            ( 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) )                                                          &
-                            + fs * sin_rot_angle                                                   &
-                              * 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )    &
-                            )
+                DO  j = nys, nyn+vynp
+                   DO  k = nzb_v_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *          &
+                                   ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
+                                     u(k,j,i+1) ) - ug(k) )
                    ENDDO
                 ENDDO
@@ -162,22 +118,10 @@
 !--       w-component
           CASE ( 3 )
-             !$ACC PARALLEL LOOP COLLAPSE(3) PRIVATE(i, j, k, flag) &
-             !$ACC PRESENT(wall_flags_total_0) &
-             !$ACC PRESENT(u, v) &
-             !$ACC PRESENT(tend)
              DO  i = nxl, nxr
                 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_total_0(k,j,i), 3 ) )
-
-                      tend(k,j,i) = tend(k,j,i)                                                    &
-                                     + fs * 0.25_wp * flag                                         &
-                                       * ( cos_rot_angle                                           &
-                                           * ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + u(k+1,j,i+1) ) &
-                                         + sin_rot_angle                                           &
-                                           * ( v(k,j,i) + v(k+1,j,i) + v(k,j+1,i) + v(k+1,j+1,i) ) &
-                                         )
+                   DO  k = nzb_w_inner(j,i)+1, nzt
+                      tend(k,j,i) = tend(k,j,i) + fs * 0.25 *             &
+                                   ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
+                                     u(k+1,j,i+1) )
                    ENDDO
                 ENDDO
@@ -186,6 +130,7 @@
           CASE DEFAULT
 
-             WRITE( message_string, * ) ' wrong component: ', component
-             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
+             IF ( myid == 0 )  PRINT*,'+++ coriolis:  wrong component: ', &
+                                      component
+             CALL local_stop
 
        END SELECT
@@ -194,40 +139,17 @@
 
 
-!--------------------------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!--------------------------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
+! Call for grid point i,j
+!------------------------------------------------------------------------------!
     SUBROUTINE coriolis_ij( i, j, component )
 
-       USE arrays_3d,                                                                              &
-           ONLY:  tend, u, ug, v, vg, w
-
-       USE basic_constants_and_equations_mod,                                                      &
-           ONLY:  pi
-
-       USE control_parameters,                                                                     &
-           ONLY:  f, fs, message_string, rotation_angle
-
-       USE indices,                                                                                &
-           ONLY:  nzb, nzt, wall_flags_total_0
-
-       USE kinds
+       USE arrays_3d
+       USE control_parameters
+       USE indices
+       USE pegrid
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  component  !< component of momentum equation
-       INTEGER(iwp) ::  i          !< running index x direction
-       INTEGER(iwp) ::  j          !< running index y direction
-       INTEGER(iwp) ::  k          !< running index z direction
-
-       REAL(wp)     ::  cos_rot_angle  !< cosine of model rotation angle
-       REAL(wp)     ::  flag           !< flag to mask topography
-       REAL(wp)     ::  sin_rot_angle  !< sine of model rotation angle
-
-!
-!--    Precalculate cosine and sine of rotation angle
-       cos_rot_angle = COS( rotation_angle * pi / 180.0_wp )
-       sin_rot_angle = SIN( rotation_angle * pi / 180.0_wp )
+       INTEGER ::  component, i, j, k
 
 !
@@ -238,16 +160,12 @@
 !--       u-component
           CASE ( 1 )
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 1 ) )
-
-                tend(k,j,i) = tend(k,j,i) + flag *                                                 &
-                            ( 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) )                                                          &
-                            - fs * cos_rot_angle                                                   &
-                              * 0.25_wp * ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + w(k,j,i) )    &
-                            )
+             DO  k = nzb_u_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25 *               &
+                                ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +   &
+                                  v(k,j+1,i) ) - vg(k) )                   &
+                                          - fs *    ( 0.25 *               &
+                                ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) + &
+                                  w(k,j,i)   ) &
+                                                    )
              ENDDO
 
@@ -255,16 +173,8 @@
 !--       v-component
           CASE ( 2 )
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 2 ) )
-
-                tend(k,j,i) = tend(k,j,i) - flag *                                                 &
-                              ( 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) )                                                        &
-                              + fs * sin_rot_angle                                                 &
-                                * 0.25_wp * ( w(k,j,i) + w(k-1,j,i) + w(k,j-1,i) + w(k-1,j-1,i) )  &
-                              )
+             DO  k = nzb_v_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) - f *     ( 0.25 *             &
+                                ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) + &
+                                  u(k,j,i+1) ) - ug(k) )
              ENDDO
 
@@ -272,22 +182,15 @@
 !--       w-component
           CASE ( 3 )
-             DO  k = nzb+1, nzt
-!
-!--             Predetermine flag to mask topography
-                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_total_0(k,j,i), 3 ) )
-
-                tend(k,j,i) = tend(k,j,i)                                                          &
-                              + fs * 0.25_wp * flag                                                &
-                                * ( cos_rot_angle                                                  &
-                                    * ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + u(k+1,j,i+1) )        &
-                                  + sin_rot_angle                                                  &
-                                    * ( v(k,j,i) + v(k+1,j,i) + v(k,j+1,i) + v(k+1,j+1,i) )        &
-                                  )
+             DO  k = nzb_w_inner(j,i)+1, nzt
+                tend(k,j,i) = tend(k,j,i) + fs * 0.25 * &
+                                ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) + &
+                                  u(k+1,j,i+1) )
              ENDDO
 
           CASE DEFAULT
 
-             WRITE( message_string, * ) ' wrong component: ', component
-             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )
+             IF ( myid == 0 )  PRINT*,'+++ coriolis:  wrong component: ', &
+                                      component
+             CALL local_stop
 
        END SELECT
