scale_atmos_diagnostic_cartesc Module Reference

module atmosphere / diagnostic / CartesianC More...

Functions/Subroutines
subroutine, public	atmos_diagnostic_cartesc_get_vel (KA, KS, KE, IA, IS, IE, JA, JS, JE, DENS, MOMZ, MOMX, MOMY, W, U, V)
	ATMOS_DIAGNOSTIC_CARTESC_get_vel W, U, V. More...

Detailed Description

module atmosphere / diagnostic / CartesianC

Description

Calculate diagnostic variables for Cartesian-C grid

Author

Team SCALE

Function/Subroutine Documentation

atmos_diagnostic_cartesc_get_vel()

subroutine, public scale_atmos_diagnostic_cartesc::atmos_diagnostic_cartesc_get_vel	(	integer, intent(in)	KA,
		integer, intent(in)	KS,
		integer, intent(in)	KE,
		integer, intent(in)	IA,
		integer, intent(in)	IS,
		integer, intent(in)	IE,
		integer, intent(in)	JA,
		integer, intent(in)	JS,
		integer, intent(in)	JE,
		real(rp), dimension(ka,ia,ja), intent(in)	DENS,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMZ,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMX,
		real(rp), dimension(ka,ia,ja), intent(in)	MOMY,
		real(rp), dimension (ka,ia,ja), intent(out)	W,
		real(rp), dimension (ka,ia,ja), intent(out)	U,
		real(rp), dimension (ka,ia,ja), intent(out)	V
	)

ATMOS_DIAGNOSTIC_CARTESC_get_vel W, U, V.

Definition at line 58 of file scale_atmos_diagnostic_cartesC.F90.

    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

References scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_gsqrt, scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_j13g, scale_atmos_grid_cartesc_metric::atmos_grid_cartesc_metric_j23g, scale_atmos_grid_cartesc_index::i_xyw, scale_atmos_grid_cartesc_index::i_xyz, and scale_prc_cartesc::prc_twod.

Referenced by mod_atmos_vars::atmos_vars_calc_diagnostics().

Here is the caller graph for this function: