scale_atmos_diagnostic_cartesC.F90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
#include "scalelib.h"
module scale_atmos_diagnostic_cartesc
  !-----------------------------------------------------------------------------
  !
  !++ used modules
  !
  use scale_precision
  use scale_io
  use scale_prof
  !-----------------------------------------------------------------------------
  implicit none
  private
  !-----------------------------------------------------------------------------
  !
  !++ Public procedure
  !
  public :: atmos_diagnostic_cartesc_get_vel

  !-----------------------------------------------------------------------------
  !
  !++ Public parameters & variables
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private procedure
  !
  !-----------------------------------------------------------------------------
  !
  !++ Private parameters & variables
  !
  !-----------------------------------------------------------------------------
contains
  !-----------------------------------------------------------------------------
  subroutine atmos_diagnostic_cartesc_get_vel( &
       KA, KS, KE, &
       IA, IS, IE, &
       JA, JS, JE, &
       DENS, &
       MOMZ, &
       MOMX, &
       MOMY, &
       W,    &
       U,    &
       V     )
    use scale_comm_cartesc, only: &
       comm_vars8, &
       comm_wait
    use scale_atmos_grid_cartesc_metric, only: &
       gsqrt => atmos_grid_cartesc_metric_gsqrt, &
       j13g  => atmos_grid_cartesc_metric_j13g,  &
       j23g  => atmos_grid_cartesc_metric_j23g
    use scale_atmos_grid_cartesc_index, only: &
       i_xyz, &
       i_xyw
    integer,  intent(in)  :: KA, KS, KE
    integer,  intent(in)  :: IA, IS, IE
    integer,  intent(in)  :: JA, JS, JE

    real(RP), intent(in)  :: DENS(ka,ia,ja)
    real(RP), intent(in)  :: MOMZ(ka,ia,ja)
    real(RP), intent(in)  :: MOMX(ka,ia,ja)
    real(RP), intent(in)  :: MOMY(ka,ia,ja)

    real(RP), intent(out) :: W   (ka,ia,ja)
    real(RP), intent(out) :: U   (ka,ia,ja)
    real(RP), intent(out) :: V   (ka,ia,ja)

    real(RP) :: momws

    integer :: k, i, j
    !---------------------------------------------------------------------------

    ! Note: W(KS,:,:) is filled because the values at i=1 or j=1 are not calculated below.
!OCL XFILL
    !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
    do j = js, je
    do i = is, ie
    do k = ks, ke-1
       w(k,i,j) = 0.5_rp * ( momz(k-1,i,j)+momz(k,i,j) ) / dens(k,i,j)
    enddo
    enddo
    enddo
!OCL XFILL
    !$omp parallel do OMP_SCHEDULE_ collapse(2) &
    !$omp private(i,j,momws)
    do j = max(2,js), je
    do i = max(2,is), ie
       ! at KS+1/2
       momws = momz(ks,i,j) &
             + ( j13g(ks,i,j,i_xyw) * ( momx(ks,i,j) + momx(ks,i-1,j) + momx(ks+1,i,j) + momx(ks+1,i-1,j) ) &
             + j23g(ks,i,j,i_xyw) * ( momy(ks,i,j) + momy(ks,i,j-1) + momy(ks+1,i,j) + momy(ks+1,i,j-1) ) ) &
             * 0.25_rp / gsqrt(ks,i,j,i_xyw)
       ! at KS
       ! momws at the surface is assumed to be zero
       w(ks,i,j) = momws * 0.5_rp &
                 - ( j13g(ks,i,j,i_xyz) * ( momx(ks,i,j) + momx(ks,i-1,j) ) &
                 + j23g(ks,i,j,i_xyz) * ( momy(ks,i,j) + momy(ks,i,j-1) ) ) &
                 * 0.5_rp / ( dens(ks,i,j) * gsqrt(ks,i,j,i_xyz) )
    enddo
    enddo
!OCL XFILL
    !$omp parallel do private(i,j) OMP_SCHEDULE_ collapse(2)
    do j = js, je
    do i = is, ie
       w(ke,i,j) = 0.5_rp * ( momz(ke-1,i,j) ) / dens(ke,i,j)
    enddo
    enddo

!OCL XFILL
    !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
    do j = js, je
    do i = max(2,is), ie
    do k = ks, ke
       u(k,i,j) = 0.5_rp * ( momx(k,i-1,j)+momx(k,i,j) ) / dens(k,i,j)
    enddo
    enddo
    enddo
!OCL XFILL
    !$omp parallel do private(j,k) OMP_SCHEDULE_ collapse(2)
    do j = js, je
    do k = ks, ke
       u(k,1,j) = momx(k,1,j) / dens(k,1,j)
    enddo
    enddo

   !OCL XFILL
    !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
    do j = max(2,js), je
    do i = is, ie
    do k = ks, ke
       v(k,i,j) = 0.5_rp * ( momy(k,i,j-1)+momy(k,i,j) ) / dens(k,i,j)
    enddo
    enddo
    enddo
!OCL XFILL
    !$omp parallel do private(i,k) OMP_SCHEDULE_ collapse(2)
    do i = is, ie
    do k = ks, ke
       v(k,i,1) = momy(k,i,1) / dens(k,i,1)
    enddo
    enddo

    !$omp parallel do private(i,j) OMP_SCHEDULE_ collapse(2)
    do j  = js, je
    do i  = is, ie
       w(   1:ks-1,i,j) = w(ks,i,j)
       u(   1:ks-1,i,j) = u(ks,i,j)
       v(   1:ks-1,i,j) = v(ks,i,j)
       w(ke+1:ka,  i,j) = w(ke,i,j)
       u(ke+1:ka,  i,j) = u(ke,i,j)
       v(ke+1:ka,  i,j) = v(ke,i,j)
    enddo
    enddo

    call comm_vars8( w(:,:,:), 1 )
    call comm_vars8( u(:,:,:), 2 )
    call comm_vars8( v(:,:,:), 3 )
    call comm_wait ( w(:,:,:), 1, .false. )
    call comm_wait ( u(:,:,:), 2, .false. )
    call comm_wait ( v(:,:,:), 3, .false. )

    return
  end subroutine atmos_diagnostic_cartesc_get_vel

end module scale_atmos_diagnostic_cartesc