source: palm/trunk/SOURCE/coriolis.f90 @ 335

 MODULE coriolis_mod

!------------------------------------------------------------------------------!
! Current revisions:
! -----------------
! Output of messages replaced by message handling routine.
!
!
! Former revisions:
! -----------------
! $Id: coriolis.f90 254 2009-03-05 15:33:42Z heinze $
!
! 106 2007-08-16 14:30:26Z raasch
! loops for u and v are starting from index nxlu, nysv, respectively (needed
! for non-cyclic boundary conditions)
!
! 75 2007-03-22 09:54:05Z raasch
! uxrp, vynp eliminated
!
! RCS Log replace by Id keyword, revision history cleaned up
!
! Revision 1.12  2006/02/23 10:08:57  raasch
! nzb_2d replaced by nzb_u/v/w_inner
!
! Revision 1.1  1997/08/29 08:57:38  raasch
! Initial revision
!
!
! Description:
! ------------
! Computation of all Coriolis terms in the equations of motion.
!------------------------------------------------------------------------------!

    PRIVATE
    PUBLIC coriolis

    INTERFACE coriolis
       MODULE PROCEDURE coriolis
       MODULE PROCEDURE coriolis_ij
    END INTERFACE coriolis

 CONTAINS


!------------------------------------------------------------------------------!
! Call for all grid points
!------------------------------------------------------------------------------!
    SUBROUTINE coriolis( component )

       USE arrays_3d
       USE control_parameters
       USE indices
       USE pegrid

       IMPLICIT NONE

       INTEGER ::  component, i, j, k


!
!--    Compute Coriolis terms for the three velocity components
       SELECT CASE ( component )

!
!--       u-component
          CASE ( 1 )
             DO  i = nxlu, nxr
                DO  j = nys, nyn
                   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
             ENDDO

!
!--       v-component
          CASE ( 2 )
             DO  i = nxl, nxr
                DO  j = nysv, nyn
                   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
             ENDDO

!
!--       w-component
          CASE ( 3 )
             DO  i = nxl, nxr
                DO  j = nys, nyn
                   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
             ENDDO

          CASE DEFAULT

             WRITE( message_string, * ) ' wrong component: ', component
             CALL message( 'coriolis', 'PA0173', 1, 2, 0, 6, 0 )

       END SELECT

    END SUBROUTINE coriolis


!------------------------------------------------------------------------------!
! Call for grid point i,j
!------------------------------------------------------------------------------!
    SUBROUTINE coriolis_ij( i, j, component )

       USE arrays_3d
       USE control_parameters
       USE indices
       USE pegrid

       IMPLICIT NONE

       INTEGER ::  component, i, j, k

!
!--    Compute Coriolis terms for the three velocity components
       SELECT CASE ( component )

!
!--       u-component
          CASE ( 1 )
             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

!
!--       v-component
          CASE ( 2 )
             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

!
!--       w-component
          CASE ( 3 )
             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 )

       END SELECT

    END SUBROUTINE coriolis_ij

 END MODULE coriolis_mod