!= セミラグ移流テスト用初期値作成
!
!= Preparation of initial condition for SLTT advection
!
! Authors::   Yoshiyuki O. TAKAHASHI
! Version::   $Id: sltt_debug.f90,v 1.2 2014/05/07 09:39:20 murashin Exp $
! Tag Name::  $Name:  $
! Copyright:: Copyright (C) GFD Dennou Club, 2008. All rights reserved.
! License::   See COPYRIGHT[link:../../../COPYRIGHT]
!

module sltt_debug

  ! 種別型パラメタ
  ! Kind type parameter
  !
  use dc_types, only: DP    ! 倍精度実数型. Double precision.

  ! 格子点設定
  ! Grid points settings
  !
  use gridset, only:       &
    &                imax, & ! 経度格子点数.
                             ! Number of grid points in longitude
    &                jmax, & ! 緯度格子点数.
                             ! Number of grid points in latitude
    &                kmax    ! 鉛直層数.
                             ! Number of vertical level

  ! 組成に関わる配列の設定
  ! Settings of array for atmospheric composition
  !
  use composition, only:                              &
    &                    ncmax
                             ! 成分の数
                             ! Number of composition

  implicit none

  public :: SLTTDebugSetUV
  public :: SLTTDebugSetQ

contains

  !--------------------------------------------------------------------------------------

  subroutine SLTTDebugSetUV( &
    & U0,                    & ! (in)
    & xyz_U, xyz_V           & ! (out)
    & )

    use constants0, only : PI
    use axesset   , only : x_Lon, y_Lat

    real(DP), intent(in ) :: U0
    real(DP), intent(out) :: xyz_U(0:imax-1, 1:jmax, 1:kmax)
    real(DP), intent(out) :: xyz_V(0:imax-1, 1:jmax, 1:kmax)


    !
    ! local variables
    !
    real(DP) :: Alpha
    integer  :: i
    integer  :: j
    integer  :: k


    Alpha =  80.0_DP * PI / 180.0_DP

    do k = 1, kmax
      do j = 1, jmax
        do i = 0, imax-1
          xyz_U(i,j,k) =                                                   &
            &  U0 * ( cos( y_Lat(j) ) * cos( Alpha )                       &
            &       + sin( y_Lat(j) ) * cos( x_Lon(i) ) * sin( Alpha ) )
          xyz_V(i,j,k) =                                                   &
            & -U0 * sin( x_Lon(i) ) * sin( Alpha )
        end do
      end do
    end do


  end subroutine SLTTDebugSetUV

  !--------------------------------------------------------------------------------------

  subroutine SLTTDebugSetQ( &
    & xyzf_QMix             & ! (out)
    & )

    use constants0, only : PI
    use constants , only : RPlanet
    use axesset   , only : x_Lon, y_Lat


    real(DP), intent(out) :: xyzf_QMix(0:imax-1, 1:jmax, 1:kmax, ncmax)


    !
    ! Local variables
    !
    real(DP) :: clon, clat
    real(DP) :: bell_radius, bell_height
    real(DP) :: dist

    integer  :: i
    integer  :: j
    integer  :: k
    integer  :: n


    clon        =  90.0_DP * PI / 180.0_DP
    clat        =  20.0_DP * PI / 180.0_DP
    bell_radius = RPlanet / 3.0_DP
    bell_radius = RPlanet
    bell_height = 1.0e-6_DP * 1.0e-10_DP


    do n = 1, ncmax
      do k = 1, kmax
        do j = 1, jmax
          do i = 0, imax-1
            dist = RPlanet                                                        &
              & * acos( sin( clat ) * sin( y_Lat(j) )                             &
              &       + cos( clat ) * cos( y_Lat(j) ) * cos( x_Lon(i) - clon ) )
            if( dist < bell_radius ) then
              xyzf_QMix(i,j,k,n) = bell_height / 2.0_DP &
                * ( 1.0_DP + cos( PI * dist / bell_radius ) )
            else
              xyzf_QMix(i,j,k,n) = 0.0_DP
            end if
          end do
        end do
      end do
    end do


    do n = 1, ncmax
      do k = 1, kmax / 2
        do j = 1, jmax
          do i = 0, imax-1
            xyzf_QMix(i,j,k,n) = 0.0_DP
          end do
        end do
      end do
    end do


  end subroutine SLTTDebugSetQ

  !--------------------------------------------------------------------------------------

end module sltt_debug

