!---------------------------------------------------------------------
!     Copyright (C) GFD Dennou Club, 2005. All rights reserved.
!---------------------------------------------------------------------
! physics_surface_main.f90 
!
! History
!   2005/09/21 Yamada Yukiko     create
!
! == TODO
! QvapFlux は潜熱フラックスなので名前が悪い.

module physics_surface_main_mod

  implicit none

  private
  public :: physics_surface_main

contains

  subroutine physics_surface_main( &
         & xyr_VelLonFlux       , & ! (inout) 速度経度成分フラックス
         & xyr_VelLatFlux       , & ! (inout) 速度緯度成分フラックス
         & xyr_TempFlux         , & ! (inout) 温度フラックス
         & xyr_QvapFlux         , & ! (inout) 比湿フラックス
         & xy_SurfVelMatrix     , & ! (out) 速度陰解行列: 地表
         & xyoo_SurfTempMatrix  , & ! (out) 温度陰解行列: 地表
         & xyoo_SurfQvapMatrix  , & ! (out) 比湿陰解行列: 地表
         & xyz_VelLon           , & ! (in) 速度経度成分
         & xyz_VelLat           , & ! (in) 速度緯度成分
         & xyz_Temp             , & ! (in) 温度 (整数)
         & xyr_Temp             , & ! (in) 温度 (半整数)
         & xy_SurfTemp          , & ! (in) 地表面温度 
         & xyz_Qvap             , & ! (in) 比湿 (整数)
         & xyz_Press            , & ! (in) 気圧 (整数)
         & xyr_Press            , & ! (in) 気圧 (半整数)
         & xyz_GeoPot           , & ! (in) 高度 (整数)
         & xy_SurfHumidCoeff    , & ! (in) 地表湿潤度
         & xy_SurfRoughLength   , & ! (in) 地表粗度長
         & xy_SurfCondition       ) ! (in) 地表状態

    !==== Dependency
    use type_mod,    only: REKIND, DBKIND, INTKIND, TOKEN, STRING
    use grid_3d_mod, only: im, jm, km
    use constants_mod, only: RAir, Cp, Grav, EL, ES0, RVap, EpsV
    use physics_surface_coeff_mod,  only: physics_surface_coeff
    use dc_trace,    only: SetDebug, BeginSub, EndSub, DbgMessage, DataDump

    implicit none

    !==== Output
    !
    real(DBKIND), intent(out) :: &
         & xy_SurfVelMatrix(im,jm)             , & ! (out) 速度陰解行列: 地表
         & xyoo_SurfTempMatrix(im,jm,0:1,-1:1) , & ! (out) 温度陰解行列: 地表
         & xyoo_SurfQvapMatrix(im,jm,0:1,-1:1)     ! (out) 比湿陰解行列: 地表

    !==== Input
    !
    real(DBKIND), intent(in) :: &
         & xyz_VelLon(im,jm,km)              , & ! (in) 速度経度成分
         & xyz_VelLat(im,jm,km)              , & ! (in) 速度緯度成分
         & xyz_Temp(im,jm,km)                , & ! (in) 温度 (整数)
         & xyr_Temp(im,jm,km+1)              , & ! (in) 温度 (半整数)
         & xy_SurfTemp(im,jm)                , & ! (in) 地表面温度 
         & xyz_Qvap(im,jm,km)                , & ! (in) 比湿 (整数)
         & xyz_Press(im,jm,km)               , & ! (in) 気圧 (整数)
         & xyr_Press(im,jm,km+1)             , & ! (in) 気圧 (半整数)
         & xyz_GeoPot(im,jm,km)              , & ! (in) 高度 (整数)
         & xy_SurfHumidCoeff(im,jm)          , & ! (in) 地表湿潤度
         & xy_SurfRoughLength(im,jm)             ! (in) 地表粗度長
    integer(INTKIND), intent(in) :: &
         & xy_SurfCondition(im,jm)               ! (in) 地表状態

    !==== In/Out
    !
    real(DBKIND), intent(inout) :: &
         & xyr_VelLonFlux(im,jm,km+1)        , & ! (inout) 速度経度成分フラックス
         & xyr_VelLatFlux(im,jm,km+1)        , & ! (inout) 速度緯度成分フラックス
         & xyr_TempFlux(im,jm,km+1)          , & ! (inout) 温度フラックス
         & xyr_QvapFlux(im,jm,km+1)              ! (inout) 比湿フラックス

    !----- 作業用内部変数 -----
    character(STRING),  parameter:: subname = "physics_surface_main"

    ! do ループ用作業変数 (東西 i*、南北 j*、鉛直 k*、波数 l*用)
    integer(INTKIND)    :: i, j

!    real(DBKIND), parameter :: RefPress        = 100000.0D0 ! 参照気圧
    real(DBKIND), parameter :: BasePotTemp     = 300.0D0    ! 基本温位
    real(DBKIND), parameter :: VelMinForRi     = 0.01       ! Ｒｉ数用風最小値
    real(DBKIND), parameter :: VelMinForVel    = 0.01       ! 運動量用風最小値
    real(DBKIND), parameter :: VelMinForTemp   = 0.01       ! 熱用風最小値
    real(DBKIND), parameter :: VelMinForQvap   = 0.01       ! 水蒸気用風最小値
    real(DBKIND), parameter :: VelMaxForVel    = 1000.      ! 運動量用風最小値
    real(DBKIND), parameter :: VelMaxForTemp   = 1000.      ! 熱用風最小値
    real(DBKIND), parameter :: VelMaxForQvap   = 1000.      ! 水蒸気用風最小値

    real(DBKIND) :: &
         & xy_SurfBulkRiNum(im,jm)         , & ! バルクＲｉ数
         & xy_SurfTempTransCoeff(im,jm)    , & ! 輸送係数：温度
         & xy_SurfQvapTransCoeff(im,jm)    , & ! 輸送係数：比湿
         & xy_SurfVelTransCoeff(im,jm)     , & ! 輸送係数：運動量
         & xy_SurfTempBulkCoeff(im,jm)     , & ! バルク係数：温度
         & xy_SurfQvapBulkCoeff(im,jm)     , & ! バルク係数：比湿
         & xy_SurfVelBulkCoeff(im,jm)      , & ! バルク係数：運動量
         & xy_SurfExner(im,jm)             , & ! Exner関数
         & xy_SurfVelAbs(im,jm)            , & ! 風速絶対値
         & xy_SurfSatQvap(im,jm)           , & ! 地表飽和比湿
         & xy_SurfDSatQvapDTemp(im,jm)         ! 地表飽和比湿変化

    continue

    !----------------------------------------------------------------
    !   開始処理
    !----------------------------------------------------------------
    call BeginSub(subname)

    !----------------------------------------------------------------
    !   地表面フラックス計算
    !----------------------------------------------------------------

    ! ---- 1. 定数計算 ----
    xy_SurfExner = ( xyz_Press(:,:,1) / xyr_Press(:,:,1)  ) ** (RAir/Cp)

    ! ---- 2. バルクＲｉ数 ----

    do i = 1, im
       do j = 1, jm
          xy_SurfVelAbs(i,j)    = SQRT ( xyz_VelLon(i,j,1)**2 + xyz_VelLat(i,j,1)**2  )
          xy_SurfBulkRiNum(i,j) = Grav / BasePotTemp &
               &        * ( xyz_Temp(i,j,1) / xy_SurfExner(i,j) - xy_SurfTemp(i,j)  ) &
               &        / MAX ( xy_SurfVelAbs(i,j) , VelMinForRi )**2 & 
               &        * xyz_GeoPot(i,j,1) 
       end do
    end do

    ! ---- 3. バルク係数 ----    

    call physics_surface_coeff( &
       & xy_SurfVelBulkCoeff , & ! (out) 
       & xy_SurfTempBulkCoeff, & ! (out) 
       & xy_SurfQvapBulkCoeff, & ! (out) 
       & xy_SurfBulkRiNum    , & ! (in) 
       & xy_SurfVelAbs       , & ! (in) 
       & xy_SurfRoughLength  , & ! (in) 
       & xy_SurfRoughLength  , & ! (in) 
       & xyz_GeoPot(:,:,1)     ) ! (in) 

   ! ----  5. 輸送係数 ----
    
    do i = 1, im
       do j = 1, jm

          xy_SurfVelTransCoeff(i,j) = xy_SurfVelBulkCoeff(i,j) &
               &    * xyr_Press(i,j,1) / (RAir * xyr_Temp(i,j,1) ) &
               &    * MIN ( MAX (xy_SurfVelAbs(i,j) , VelMinForVel ) , VelMaxForVel )
          
          xy_SurfTempTransCoeff(i,j) = xy_SurfTempBulkCoeff(i,j) &
               &    * xyr_Press(i,j,1) / (RAir * xyr_Temp(i,j,1) ) &
               &    * MIN ( MAX (xy_SurfVelAbs(i,j) , VelMinForTemp ) , VelMaxForTemp )
          
          xy_SurfQvapTransCoeff(i,j) = xy_SurfQvapBulkCoeff(i,j) &
               &    * xyr_Press(i,j,1) / (RAir * xyr_Temp(i,j,1) ) &
               &    * MIN ( MAX (xy_SurfVelAbs(i,j) , VelMinForQvap ) , VelMaxForQvap )

       end do
    end do

   ! ----  5. 飽和比湿----

    xy_SurfSatQvap = EpsV * ES0  &
         & *  EXP( EL / RVap * (1./273. - 1./xy_SurfTemp ) ) &
         & / xyr_Press(:,:,1)
    xy_SurfDSatQvapDTemp = EL * xy_SurfSatQvap &
         & / ( RVap * xy_SurfTemp * xy_SurfTemp )

   ! ----  6. フラックス----

    xyr_VelLonFlux(:,:,1) = xyr_VelLonFlux(:,:,1) &
         &                 - xy_SurfVelTransCoeff * xyz_VelLon(:,:,1) 
    xyr_VelLatFlux(:,:,1) = xyr_VelLatFlux(:,:,1) &
         &                 - xy_SurfVelTransCoeff * xyz_VelLat(:,:,1) 
    xyr_TempFlux(:,:,1) = xyr_TempFlux(:,:,1) &
         &               + Cp * xy_SurfTempTransCoeff &
         &                * (   xy_SurfTemp           &
         &                    - xyz_Temp(:,:,1) / xy_SurfExner  )
    xyr_QvapFlux(:,:,1) = xyr_QvapFlux(:,:,1) &
         &                 + EL * xy_SurfQvapTransCoeff * xy_SurfHumidCoeff &
         &                   * ( xy_SurfSatQvap - xyz_Qvap(:,:,1) )

   ! ----  5. 陰解用行列 ----


    xyoo_SurfTempMatrix = 0.0d0
    xyoo_SurfQvapMatrix = 0.0d0


    xy_SurfVelMatrix = xy_SurfVelTransCoeff

    xyoo_SurfTempMatrix(:,:,1,0) =   Cp * xy_SurfTempTransCoeff / xy_SurfExner
    xyoo_SurfTempMatrix(:,:,0,1) = - Cp * xy_SurfTempTransCoeff / xy_SurfExner

    xyoo_SurfQvapMatrix(:,:,1,0) =   Cp * xy_SurfQvapTransCoeff * xy_SurfHumidCoeff
    xyoo_SurfQvapMatrix(:,:,0,1) = - Cp * xy_SurfQvapTransCoeff * xy_SurfHumidCoeff


    do i = 1, im
       do j = 1, jm
          if ( xy_SurfCondition(i,j) .GE. 1 ) then 

             xyoo_SurfTempMatrix(i,j,1,-1) = - Cp * xy_SurfTempTransCoeff(i,j)
             xyoo_SurfTempMatrix(i,j,0,0)  =   Cp * xy_SurfTempTransCoeff(i,j)

             xyoo_SurfQvapMatrix(i,j,1,-1) = - EL * xy_SurfQvapTransCoeff(i,j) &
                  &        * xy_SurfHumidCoeff(i,j) * xy_SurfDSatQvapDTemp(i,j)
             xyoo_SurfQvapMatrix(i,j,0,0)  =   EL * xy_SurfQvapTransCoeff(i,j) &
                  &        * xy_SurfHumidCoeff(i,j) * xy_SurfDSatQvapDTemp(i,j)

          end if
       end do
    end do

    !----------------------------------------------------------------
    !   終了処理
    !----------------------------------------------------------------
    call EndSub(subname)

  end subroutine physics_surface_main


end module physics_surface_main_mod
















