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_prc_cartesc, only: &
       prc_twod
    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
    !---------------------------------------------------------------------------
 
    !$acc data copyin(DENS, MOMZ, MOMY, MOMX, GSQRT, J23G, J13G) copyout(W, U, V)
 
    ! 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)
    !$acc kernels
    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
    !$acc end kernels
    if ( prc_twod ) then
!OCL XFILL
       !$omp parallel do OMP_SCHEDULE_ &
       !$omp private(j,momws)
       !$acc kernels
       do j = max(2,js), je
          ! at KS+1/2
          momws = momz(ks,is,j) &
                + j23g(ks,is,j,i_xyw) * ( momy(ks,is,j) + momy(ks,is,j-1) + momy(ks+1,is,j) + momy(ks+1,is,j-1) ) &
                * 0.25_rp / gsqrt(ks,is,j,i_xyw)
          ! at KS
          ! momws at the surface is assumed to be zero
          w(ks,is,j) = ( momws * 0.5_rp                                            &
                       - j23g(ks,is,j,i_xyz) * ( momy(ks,is,j) + momy(ks,is,j-1) ) &
                         * 0.5_rp / gsqrt(ks,is,j,i_xyz)                           &
                      ) / dens(ks,is,j)
       enddo
       !$acc end kernels
    else
!OCL XFILL
       !$omp parallel do OMP_SCHEDULE_ collapse(2) &
       !$omp private(i,j,momws)
       !$acc kernels
       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 / gsqrt(ks,i,j,i_xyz)                              &
                      ) / dens(ks,i,j)
       enddo
       enddo
       !$acc end kernels
    end if
!OCL XFILL
    !$omp parallel do private(i,j) OMP_SCHEDULE_ collapse(2)
    !$acc kernels
    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
    !$acc end kernels
 
    if ( prc_twod ) then
!OCL XFILL
       !$omp parallel do private(j,k) OMP_SCHEDULE_
       !$acc kernels
       do j = js, je
       do k = ks, ke
          u(k,is,j) = momx(k,is,j) / dens(k,is,j)
       enddo
       enddo
       !$acc end kernels
    else
!OCL XFILL
       !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
       !$acc kernels
       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
       !$acc end kernels
!OCL XFILL
       !$omp parallel do private(j,k) OMP_SCHEDULE_ collapse(2)
       !$acc kernels
       do j = js, je
       do k = ks, ke
          u(k,1,j) = momx(k,1,j) / dens(k,1,j)
       enddo
       enddo
       !$acc end kernels
    end if
 
   !OCL XFILL
    !$omp parallel do private(i,j,k) OMP_SCHEDULE_ collapse(2)
    !$acc kernels
    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
    !$acc end kernels
!OCL XFILL
    !$omp parallel do private(i,k) OMP_SCHEDULE_ collapse(2)
    !$acc kernels
    do i = is, ie
    do k = ks, ke
       v(k,i,1) = momy(k,i,1) / dens(k,i,1)
    enddo
    enddo
    !$acc end kernels
 
    !$omp parallel do private(i,j) OMP_SCHEDULE_ collapse(2)
    !$acc kernels
    do j  = js, je
    do i  = is, ie
       !$acc loop seq
       do k = 1, ks-1
          w(k,i,j) = w(ks,i,j)
          u(k,i,j) = u(ks,i,j)
          v(k,i,j) = v(ks,i,j)
       end do
       !$acc loop seq
       do k = ke+1, ka
          w(k,i,j) = w(ke,i,j)
          u(k,i,j) = u(ke,i,j)
          v(k,i,j) = v(ke,i,j)
       end do
    enddo
    enddo
    !$acc end kernels
 
    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. )
 
    !$acc end data
 
    return
  end subroutine atmos_diagnostic_cartesc_get_vel
 
end module scale_atmos_diagnostic_cartesc