Class dcpam_ape_physics_mod
In: physics/dcpam_ape_physics.f90

Dependency

Methods

Included Modules

type_mod grid_3d_mod dycore_type_mod time_mod spml_mod constants_mod io_gt4_out_mod dc_trace physics_interpolate_mod physics_negq_mod physics_lscond_mod physics_cumulus_adjust_mod physics_dryadjust_mod physics_ground_mod physics_radiation_main_mod physics_verdiff_main_mod physics_surface_main_mod physics_implicit_mod dycore_grid_mod

Public Instance methods

Subroutine :
Dims :type(DYCORE_DIMS), intent(in)
: 次元データ全種

==== In/Out

Vars_a :type(DYCORE_VARS), intent(inout)
: 格子点データ全種(t+Δt)

Dependency

Dependency

[Source]

  subroutine dcpam_ape_physics( Dims, Vars_a )
    !==== Dependency
    use dycore_type_mod, only: DYCORE_VARS, DYCORE_DIMS, STRING, INTKIND,                      REKIND, DBKIND
    use grid_3d_mod,     only: im, jm, km
    use time_mod,    only: DelTime
    use spml_mod,    only: wa_Div_xya_xya, xya_wa, wa_xya, xy_w, w_xy,  xya_GradLon_wa,xya_GradLat_wa, wa_LaplaInv_wa
    use constants_mod, only: R0
    use io_gt4_out_mod , only: io_gt4_out_Put
    use dc_trace,        only: BeginSub, EndSub, DbgMessage
    use physics_interpolate_mod, only: physics_interpolate_temp,                              physics_interpolate_geopot
    use physics_negq_mod, only: physics_negq
    use physics_lscond_mod     , only: physics_lscond
    use physics_cumulus_adjust_mod , only: physics_cumulus_adjust
    use physics_dryadjust_mod , only: physics_dryadjust
    use physics_ground_mod, only: physics_ground
    use physics_radiation_main_mod, only: physics_radiation_main,  physics_radiation_deltemp
    use physics_verdiff_main_mod, only: physics_verdiff_main
    use physics_surface_main_mod, only: physics_surface_main
    use physics_implicit_mod, only: physics_implicit_init,  physics_implicit_integrate
    use dycore_grid_mod, only: nm

    implicit none

    !==== Input
    !
    type(DYCORE_DIMS), intent(in)   :: Dims   ! 次元データ全種
    !
    !==== In/Out
    !
    type(DYCORE_VARS), intent(inout):: Vars_a ! 格子点データ全種(t+Δt)

    !----- 作業用内部変数 -----
    character(STRING),  parameter:: subname = "dcpam_ape_physics"
    real(DBKIND)    ::   xyr_Temp(im,jm,km+1)    ,  xyz_Press(im,jm,km)     ,  xyr_Press(im,jm,km+1)   ,  xyz_GeoPot(im,jm,km)    ,  xyr_GeoPot(im,jm,km+1)  ,  xyz_DNegQvap1Dt(im,jm,km),  xyz_DNegQvap2Dt(im,jm,km),  xyz_DLscTempDt(im,jm,km),  xyz_DLscQvapDt(im,jm,km),  xy_LscRain(im,jm)       ,  xyz_DCumulusTempDt(im,jm,km) ,  xyz_DCumulusQvapDt(im,jm,km) ,  xy_CumulusRain(im,jm)   ,  xyz_DDryTempDt(im,jm,km),  xy_Rain(im,jm)          ,  xy_Ps_b(im,jm)              ! 地表面気圧

    real(DBKIND)    ::   xyz_DRadLTempDt(im,jm,km)  , xyz_DRadSTempDt(im,jm,km)  , xy_SurfTemp(im,jm)         , xy_SurfAlbedo(im,jm)       , xy_SurfHumidCoeff(im,jm)   , xy_SurfRoughLength(im,jm)  , xy_SurfHeatCapacity(im,jm) , xy_GroundTempFlux(im,jm)   , xyr_RadLFlux(im,jm,km+1)          ,  xyo_SurfRadLMatrix(im,jm,-1:1)    ,  xyro_DelRadLFlux(im,jm,km+1,0:1)  ,  xyr_RadSFlux(im,jm,km+1)          ,  xyr_VelLonFlux(im,jm,km+1)        ,  xyr_VelLatFlux(im,jm,km+1)        ,  xyr_TempFlux(im,jm,km+1)          ,  xyr_QvapFlux(im,jm,km+1)          ,  xyzo_VelMatrix(im,jm,km,-1:1)     ,  xyzo_TempMatrix(im,jm,0:km,-1:1)  ,  xyzo_QvapMatrix(im,jm,km,-1:1)    ,  xy_SurfVelMatrix(im,jm)           ,  xyoo_SurfTempMatrix(im,jm,0:1,-1:1)  ,  xyoo_SurfQvapMatrix(im,jm,0:1,-1:1)  ,  xyz_DVerdiffVelLonDt(im,jm,km)    ,  xyz_DVerdiffVelLatDt(im,jm,km)    ,  xyz_DVerdiffTempDt(im,jm,km)      ,  xyz_DVerdiffSurfTempDt(im,jm)     ,  xyz_DVerdiffQvapDt(im,jm,km)      !, 

    integer(INTKIND)    :: xy_SurfCondition(im,jm)    ! 地表状態
    integer(INTKIND)    :: i, j, k

    real(DBKIND)    ::    wz_Psi_a((nm+1)*(nm+1), km) ,  wz_Chi_a((nm+1)*(nm+1), km)

    continue


    !----------------------------------------------------------------
    !   開始処理
    !----------------------------------------------------------------
    call BeginSub(subname)
  
    !-------------------------------------------------------------------
    ! 1. 物理過程演算の初期設定
    !-------------------------------------------------------------------

    !----- 変数初期化 -----
    xyz_DNegQvap1Dt = 0.0d0
    xyz_DNegQvap2Dt = 0.0d0
    xyz_DLscTempDt = 0.0d0
    xyz_DLscQvapDt = 0.0d0
    xy_LscRain     = 0.0d0
    xyz_DCumulusTempDt = 0.0d0
    xyz_DCumulusQvapDt = 0.0d0
    xy_CumulusRain = 0.0d0
    xyz_DDryTempDt = 0.0d0
    xy_Rain        = 0.0d0

    xy_Ps_b = Vars_a%xy_Ps
    
    !----------------------------------------------------------------
    !  2. 地表条件設定
    !----------------------------------------------------------------
    ! 本当は粗度や湿潤度やアルベド等も決めなくてはならない.
    call physics_ground(   xy_SurfTemp        ,   Dims%y_Lat%a_Dim     ) ! (in) 経度座標

    xy_SurfAlbedo = 0.15         ! 地表アルベド
    xy_SurfHumidCoeff = 1.0      ! 地表湿潤度
    xy_SurfRoughLength = 0.0001  ! 地表粗度長
    xy_SurfCondition = 0         ! 地表状態
    xy_SurfHeatCapacity = 0.0    ! 地表熱容量
    xy_GroundTempFlux  = 0.0     ! 地中熱フラックス

    !----------------------------------------------------------------
    !  3. 温度半整数 sigma 補間, 気圧と高度の算出 (1)
    !----------------------------------------------------------------

    !----- 温度半整数 sigma 補間 -----
    call physics_interpolate_temp(  xyr_Temp              ,  Vars_a%xyz_Temp       ,  Dims%z_Sigma%a_Dim    ,  Dims%r_Sigma%a_Dim    )   ! (in) σレベル(半整数)座標

    !----- 気圧と高度の算出 -----
    call physics_interpolate_geopot(  xyz_Press            ,  xyr_Press            ,  xyz_GeoPot           ,  xyr_GeoPot           ,  Vars_a%xy_Ps         ,  Vars_a%xyz_Temp      ,  xyr_Temp             ,  Dims%z_Sigma%a_Dim   ,  Dims%r_Sigma%a_Dim   )   ! (in) σレベル(半整数)座標

    !----------------------------------------------------------------
    !  4. 負の水蒸気除去(1)
    !----------------------------------------------------------------
    call physics_negq(  Vars_a%xyz_Qvap      ,  xyz_DNegQvap1Dt      ,  xyr_Press            ,  2.0d0*DelTime  )         ! (in) 2Δt

    !----------------------------------------------------------------
    !  5. 湿潤過程 (積雲)
    !----------------------------------------------------------------
    call physics_cumulus_adjust(  Vars_a%xyz_Temp     ,  Vars_a%xyz_Qvap     ,  xy_CumulusRain      ,  xyz_DCumulusTempDt  ,  xyz_DCumulusQvapDt  ,  xyz_Press           ,  xyr_Press           ,  2.0d0*DelTime )         ! (in) 2Δt

    !----------------------------------------------------------------
    !  6. 湿潤過程 (大規模凝結)
    !----------------------------------------------------------------
    call physics_lscond(  Vars_a%xyz_Temp      ,  Vars_a%xyz_Qvap      ,  xy_LscRain           ,  xyz_DLscTempDt       ,  xyz_DLscQvapDt       ,  xyz_Press            ,  xyr_Press            ,  2.0d0*DelTime  )         ! (in) 2Δt

    !----------------------------------------------------------------
    !  7. 負の水蒸気除去(2)
    !----------------------------------------------------------------
    call physics_negq(  Vars_a%xyz_Qvap      ,  xyz_DNegQvap1Dt       ,  xyr_Press            ,  2.0d0*DelTime  )         ! (in) 2Δt

    !----------------------------------------------------------------
    !  8. 温度半整数 sigma 補間, 気圧と高度の算出 (2)
    !----------------------------------------------------------------

    !----- Ps の計算しなおし -----
    do k = 1, km
       Vars_a%xy_Ps(:,:) = Vars_a%xy_Ps(:,:)  + ( xyz_DLscQvapDt(:,:,k)      + xyz_DCumulusQvapDt(:,:,k)      + xyz_DNegQvap1Dt(:,:,k)     )   * ( xyr_Press(:,:,k) - xyr_Press(:,:,k+1) )   * 2.0d0 * DelTime
    end do

    !----- 温度半整数 sigma 補間 -----
    call physics_interpolate_temp(  xyr_Temp              ,  Vars_a%xyz_Temp       ,  Dims%z_Sigma%a_Dim    ,  Dims%r_Sigma%a_Dim    )   ! (in) σレベル(半整数)座標

    !----- 気圧と高度の算出 -----
    call physics_interpolate_geopot(  xyz_Press            ,  xyr_Press            ,  xyz_GeoPot           ,  xyr_GeoPot           ,  Vars_a%xy_Ps         ,  Vars_a%xyz_Temp      ,  xyr_Temp             ,  Dims%z_Sigma%a_Dim   ,  Dims%r_Sigma%a_Dim   )   ! (in) σレベル(半整数)座標

    !----------------------------------------------------------------
    !  9. 陰解配列初期化
    !----------------------------------------------------------------
    call physics_implicit_init(  xyr_VelLonFlux       ,  xyr_VelLatFlux       ,  xyr_TempFlux         ,  xyr_QvapFlux         ,  xyzo_VelMatrix       ,  xyzo_TempMatrix      ,  xyzo_QvapMatrix      ,  xyr_Press            ,  2.0d0*DelTime        ,  xy_SurfHeatCapacity  ,  xy_SurfCondition       ) ! (in) 地表状態

    !----------------------------------------------------------------
    !  10. 放射 flux
    !----------------------------------------------------------------
    call physics_radiation_main(  xyr_RadLFlux              ,  xyo_SurfRadLMatrix        ,  xyro_DelRadLFlux          ,  xyr_RadSFlux              ,  Vars_a%xyz_Temp           ,  xy_SurfTemp               ,  Vars_a%xyz_Qvap           ,  xyr_Press                 ,  Dims%x_Lon%a_Dim          ,  Dims%y_Lat%a_Dim          ,  xy_SurfAlbedo             )   ! (in) 地表アルベド

    !----------------------------------------------------------------
    !  11. 鉛直拡散 flux
    !----------------------------------------------------------------
    call physics_verdiff_main(  xyr_VelLonFlux       ,  xyr_VelLatFlux       ,  xyr_TempFlux         ,  xyr_QvapFlux         ,  xyzo_VelMatrix       ,  xyzo_TempMatrix      ,  xyzo_QvapMatrix      ,  Vars_a%xyz_VelLon    ,  Vars_a%xyz_VelLat    ,  Vars_a%xyz_Temp      ,  xyr_Temp             ,  Vars_a%xyz_Qvap      ,  xyz_Press            ,  xyr_Press            ,  xyz_GeoPot           ,  xyr_GeoPot             ) ! (in) 高度 (半整数)

    !----------------------------------------------------------------
    !  12. 地表 flux
    !----------------------------------------------------------------
    call physics_surface_main(  xyr_VelLonFlux       ,  xyr_VelLatFlux       ,  xyr_TempFlux         ,  xyr_QvapFlux         ,  xy_SurfVelMatrix     ,  xyoo_SurfTempMatrix  ,  xyoo_SurfQvapMatrix  ,  Vars_a%xyz_VelLon    ,  Vars_a%xyz_VelLat    ,  Vars_a%xyz_Temp      ,  xyr_Temp             ,  xy_SurfTemp          ,  Vars_a%xyz_Qvap      ,  xyz_Press            ,  xyr_Press            ,  xyz_GeoPot           ,  xy_SurfHumidCoeff    ,  xy_SurfRoughLength   ,  xy_SurfCondition       ) ! (in) 地表状態

    !----------------------------------------------------------------
    !  13. 時間変化率の計算 (implicit)
    !----------------------------------------------------------------
    call physics_implicit_integrate(  xyz_DVerdiffVelLonDt    ,  xyz_DVerdiffVelLatDt    ,  xyz_DVerdiffTempDt      ,  xyz_DVerdiffSurfTempDt  ,  xyz_DVerdiffQvapDt      ,  xyr_VelLonFlux          ,  xyr_VelLatFlux          ,  xyr_TempFlux            ,  xyr_RadSFlux(:,:,1)     ,  xyr_RadLFlux(:,:,1)     ,  xy_GroundTempFlux       ,  xyr_QvapFlux            ,  xyzo_VelMatrix          ,  xyzo_TempMatrix         ,  xyzo_QvapMatrix         ,  xy_SurfVelMatrix        ,  xyoo_SurfTempMatrix     ,  xyoo_SurfQvapMatrix     ,  xyo_SurfRadLMatrix      ,  2.0d0*DelTime           ,  xy_SurfCondition          ) ! (in) 地表状態

    !----------------------------------------------------------------
    !  14. 放射による温度変化率
    !----------------------------------------------------------------

    do k = 1, km+1
       xyr_RadLFlux(:,:,k) = xyr_RadLFlux(:,:,k)      + (xyz_DVerdiffSurfTempDt(:,:) * xyro_DelRadLFlux(:,:,k,0)          + xyz_DVerdiffTempDt(:,:,1) * xyro_DelRadLFlux(:,:,k,1) )      * 2.0d0*DelTime
    end do

    call physics_radiation_deltemp(   xyz_DRadLTempDt         ,   xyz_DRadSTempDt         ,   xyr_RadLFlux            ,   xyr_RadSFlux            ,   xyr_Press                 )   ! (in) 圧力 (半整数)

    !----------------------------------------------------------------
    !  15. 温度変化分の足し込み
    !----------------------------------------------------------------
    Vars_a%xyz_Temp = Vars_a%xyz_Temp                +  ( xyz_DRadLTempDt + xyz_DRadSTempDt ) * 2.0d0*DelTime

    Vars_a%xyz_Temp = Vars_a%xyz_Temp                +  ( xyz_DVerdiffTempDt ) * 2.0d0* DelTime

    Vars_a%xyz_Qvap = Vars_a%xyz_Qvap                +  ( xyz_DVerdiffQvapDt ) * 2.0d0* DelTime

    Vars_a%xyz_VelLon = Vars_a%xyz_VelLon                +  ( xyz_DVerdiffVelLonDt ) * 2.0d0* DelTime
    
    Vars_a%xyz_VelLat = Vars_a%xyz_VelLat                +  ( xyz_DVerdiffVelLatDt ) * 2.0d0* DelTime

    !----------------------------------------------------------------
    !  16. 温度半整数 sigma 補間, 気圧と高度の算出 (3)
    !----------------------------------------------------------------

    !----- Ps の計算しなおし -----
    do k = 1, km
       Vars_a%xy_Ps(:,:) = Vars_a%xy_Ps(:,:)  +  xyz_DVerdiffQvapDt(:,:,k)     * ( xyr_Press(:,:,k) - xyr_Press(:,:,k+1) )    * 2.0d0 * DelTime
    end do

    !----- 温度半整数 sigma 補間 -----
    call physics_interpolate_temp(  xyr_Temp              ,  Vars_a%xyz_Temp       ,  Dims%z_Sigma%a_Dim    ,  Dims%r_Sigma%a_Dim    )   ! (in) σレベル(半整数)座標

    !----- 気圧と高度の算出 -----
    call physics_interpolate_geopot(  xyz_Press            ,  xyr_Press            ,  xyz_GeoPot           ,  xyr_GeoPot           ,  Vars_a%xy_Ps         ,  Vars_a%xyz_Temp      ,  xyr_Temp             ,  Dims%z_Sigma%a_Dim   ,  Dims%r_Sigma%a_Dim   )   ! (in) σレベル(半整数)座標

    !----------------------------------------------------------------
    !  17. 乾燥対流調節
    !----------------------------------------------------------------
    call physics_dryadjust(  Vars_a%xyz_Temp       ,  xyz_DDryTempDt        ,  xyz_Press             ,  xyr_Press             ,  2.0d0*DelTime  )          ! (in) 2Δt

    !----------------------------------------------------------------
    !  18. 負の水蒸気除去(3)
    !----------------------------------------------------------------
    call physics_negq(  Vars_a%xyz_Qvap      ,  xyz_DNegQvap2Dt       ,  xyr_Press            ,  2.0d0*DelTime  )         ! (in) 2Δt

    !----------------------------------------------------------------
    !  19. Ps の計算しなおし 
    !----------------------------------------------------------------
    do k = 1, km
       Vars_a%xy_Ps(:,:) = Vars_a%xy_Ps(:,:)  + xyz_DNegQvap2Dt(:,:,k)   * ( xyr_Press(:,:,k) - xyr_Press(:,:,k+1) )   * 2.0d0 * DelTime
    end do

    !----------------------------------------------------------------
    !  20. 変数出力
    !----------------------------------------------------------------
!    call io_gt4_out_Put(  'GeoPot', real(xyz_GeoPot(:,:,:), DBKIND)  )
!    call io_gt4_out_Put(  'Press', real(xyz_Press(:,:,:), DBKIND)  )
!    call io_gt4_out_Put(  'SurfTemp', real(xy_SurfTemp(:,:), DBKIND)  )

    call io_gt4_out_Put(  'DNegQvapDt',   real( (xyz_DNegQvap1Dt(:,:,:) + xyz_DNegQvap2Dt(:,:,:)), DBKIND)  )
    call io_gt4_out_Put(  'DLscTempDt',                       real(xyz_DLscTempDt(:,:,:), DBKIND)  )
    call io_gt4_out_Put(  'DLscQvapDt',                       real(xyz_DLscQvapDt(:,:,:), DBKIND)  )
    call io_gt4_out_Put(  'LscRain', real(xy_LscRain(:,:), DBKIND)  )

    call io_gt4_out_Put(  'DCumulusTempDt',                       real(xyz_DCumulusTempDt(:,:,:), DBKIND)  )

    call io_gt4_out_Put(  'DCumulusQvapDt',                       real(xyz_DCumulusQvapDt(:,:,:), DBKIND)  )

    call io_gt4_out_Put(  'CumulusRain', real(xy_CumulusRain(:,:), DBKIND)  )

    call io_gt4_out_Put(  'DDryTempDt',                       real(xyz_DDryTempDt(:,:,:), DBKIND)  )

    xy_Rain = xy_LscRain + xy_CumulusRain
    call io_gt4_out_Put(  'Rain', real(xy_Rain(:,:), DBKIND)  )

    call io_gt4_out_Put(  'DPsDt',  real( (Vars_a%xy_Ps(:,:) - xy_Ps_b(:,:)), DBKIND)  )

    call io_gt4_out_Put(  'DRadLTempDt', real(xyz_DRadLTempDt(:,:,:), DBKIND)  )
    call io_gt4_out_Put(  'DRadSTempDt', real(xyz_DRadSTempDt(:,:,:), DBKIND)  )
    call io_gt4_out_Put('DVerdiffVelLonDt',                       real(xyz_DVerdiffVelLonDt(:,:,:), DBKIND) )
    call io_gt4_out_Put('DVerdiffVelLatDt',                      real(xyz_DVerdiffVelLatDt(:,:,:), DBKIND) )
    call io_gt4_out_Put('DVerdiffTempDt', real(xyz_DVerdiffTempDt(:,:,:), DBKIND) )
    call io_gt4_out_Put('DVerdiffQvapDt', real(xyz_DVerdiffQvapDt(:,:,:), DBKIND) )

    !-------------------------------------------------------------------
    !  21. Generate Vorticity and Divergence from Velocity
    !-------------------------------------------------------------------
    
    Vars_a%xyz_Vor =   xya_wa( wa_Div_xya_xya( Vars_a%xyz_VelLat,-Vars_a%xyz_VelLon )/R0)
    Vars_a%xyz_Div =  xya_wa( wa_Div_xya_xya( Vars_a%xyz_VelLon, Vars_a%xyz_VelLat ) /R0)
    
!    wz_Psi_a = wa_LaplaInv_wa(  wa_xya( Vars_a%xyz_Vor )  ) * R0**2
!    wz_Chi_a = wa_LaplaInv_wa(  wa_xya( Vars_a%xyz_Div )  ) * R0**2

!    Vars_a%xyz_VelLon = (  xya_GradLon_wa( wz_Chi_a ) 
!                         - xya_GradLat_wa( wz_Psi_a )  ) / R0

!    Vars_a%xyz_VelLat = (  xya_GradLon_wa( wz_Psi_a ) 
!                         + xya_GradLat_wa( wz_Chi_a )  ) / R0

!    Vars_a%xyz_Temp = xya_wa( wa_xya(Vars_a%xyz_Temp) )
!    Vars_a%xyz_Qvap = xya_wa( wa_xya(Vars_a%xyz_Qvap) )
!    Vars_a%xy_Ps = xy_w( w_xy(Vars_a%xy_Ps) )


    !----------------------------------------------------------------
    !   終了処理
    !----------------------------------------------------------------
    call EndSub(subname)
    
  end subroutine dcpam_ape_physics

[Validate]